hodatime (empty) → 0.1.1.1

raw patch · 44 files changed

+2142/−0 lines, 44 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, containers, criterion, directory, filepath, hodatime, mtl, random, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, time

Files

• LICENSE +11/−0
• Setup.hs +2/−0
• bench/HodaTime/OffsetBench.hs +17/−0
• bench/bench.hs +19/−0
• hodatime.cabal +114/−0
• src/Data/HodaTime.hs +4/−0
• src/Data/HodaTime/Calendar/Coptic.hs +6/−0
• src/Data/HodaTime/Calendar/Gregorian.hs +56/−0
• src/Data/HodaTime/Calendar/Gregorian/CacheTable.hs +103/−0
• src/Data/HodaTime/Calendar/Gregorian/Internal.hs +171/−0
• src/Data/HodaTime/Calendar/Hebrew.hs +9/−0
• src/Data/HodaTime/Calendar/Internal.hs +9/−0
• src/Data/HodaTime/Calendar/Islamic.hs +16/−0
• src/Data/HodaTime/Calendar/Iso.hs +14/−0
• src/Data/HodaTime/Calendar/Persian.hs +4/−0
• src/Data/HodaTime/CalendarDate.hs +12/−0
• src/Data/HodaTime/CalendarDateTime.hs +23/−0
• src/Data/HodaTime/CalendarDateTime/Internal.hs +117/−0
• src/Data/HodaTime/Constants.hs +90/−0
• src/Data/HodaTime/Duration.hs +74/−0
• src/Data/HodaTime/Duration/Internal.hs +37/−0
• src/Data/HodaTime/Instant.hs +102/−0
• src/Data/HodaTime/Instant/Clock.hsc +41/−0
• src/Data/HodaTime/Instant/Internal.hs +22/−0
• src/Data/HodaTime/Internal.hs +62/−0
• src/Data/HodaTime/Interval.hs +53/−0
• src/Data/HodaTime/LocalTime.hs +45/−0
• src/Data/HodaTime/LocalTime/Internal.hs +88/−0
• src/Data/HodaTime/Offset.hs +91/−0
• src/Data/HodaTime/OffsetDateTime.hs +6/−0
• src/Data/HodaTime/OffsetDateTime/Internal.hs +21/−0
• src/Data/HodaTime/TimeZone.hs +64/−0
• src/Data/HodaTime/TimeZone/Internal.hs +48/−0
• src/Data/HodaTime/TimeZone/Olson.hs +73/−0
• src/Data/HodaTime/ZonedDateTime.hs +6/−0
• src/Data/HodaTime/ZonedDateTime/Internal.hs +15/−0
• tests/HodaTime/Calendar/GregorianTest.hs +94/−0
• tests/HodaTime/CalendarDateTimeTest.hs +96/−0
• tests/HodaTime/DurationTest.hs +71/−0
• tests/HodaTime/InstantTest.hs +35/−0
• tests/HodaTime/LocalTimeTest.hs +61/−0
• tests/HodaTime/OffsetTest.hs +93/−0
• tests/HodaTime/Util.hs +21/−0
• tests/test.hs +26/−0

@@ -0,0 +1,11 @@+Copyright 2017 Jason Johnson++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,17 @@+module HodaTime.OffsetBench+(+  offsetBenches+)+where++import Criterion.Main+import Data.HodaTime.Offset (add, fromHours)++offsetBenches :: Benchmark+offsetBenches = bgroup "Offset Benchmarks" [addHour]++addHour :: Benchmark+addHour = bench "add 1"  $ whnf (add oneHour) twoHours+  where+    oneHour = fromHours (1 :: Int)+    twoHours = fromHours (2  :: Int)

@@ -0,0 +1,19 @@+module Main (+    main+ ) where++import Criterion.Main+import Criterion.Types (Config(..))++import HodaTime.OffsetBench (offsetBenches)++main :: IO ()+main = defaultMainWith benchConfig [benches]++benches :: Benchmark+benches = bgroup "Benchmarks" [offsetBenches]++-- This configuration enables garbage collection between benchmarks. It is a+-- good idea to do so. Otherwise GC might distort your results+benchConfig :: Config+benchConfig = defaultConfig { forceGC = True }

@@ -0,0 +1,114 @@+name:           hodatime+version:        0.1.1.1+stability:      experimental+license:        BSD3+license-file:   LICENSE+cabal-version:  >=1.10+build-type:     Simple+author:         Jason Johnson+maintainer:     <jason.johnson.081@gmail.com>+homepage:       https://github.com/jason-johnson/hodatime+bug-reports:    https://github.com/jason-johnson/hodatime/issues+synopsis:       A fully featured date/time library based on Nodatime+description:    A library for dealing with time, dates, calendars and time zones+category:       Data, Time+build-type:     Simple+tested-with:    GHC == 8.0.2++source-repository head+    type:     git+    location: https://github.com/jason-johnson/hodatime++library+  default-language:+                   Haskell2010+  hs-source-dirs:  src+  build-depends:+                   base >= 4.9 && < 4.10,+                   mtl,+                   binary,+                   bytestring,+                   directory,+                   filepath,+                   containers+  ghc-options:     -Wall+  exposed-modules:+                   Data.HodaTime,+                   Data.HodaTime.Calendar.Coptic,+                   Data.HodaTime.Calendar.Gregorian,+                   Data.HodaTime.Calendar.Hebrew,+                   Data.HodaTime.Calendar.Islamic,+                   Data.HodaTime.Calendar.Iso,+                   Data.HodaTime.Calendar.Persian,+                   Data.HodaTime.CalendarDate,+                   Data.HodaTime.CalendarDateTime,+                   Data.HodaTime.Duration,+                   Data.HodaTime.Instant,+                   Data.HodaTime.Interval,+                   Data.HodaTime.Offset,+                   Data.HodaTime.LocalTime,+                   Data.HodaTime.OffsetDateTime,+                   Data.HodaTime.TimeZone+                   Data.HodaTime.ZonedDateTime+  other-modules:+                   Data.HodaTime.Constants,+                   Data.HodaTime.Internal,+                   Data.HodaTime.Duration.Internal,+                   Data.HodaTime.LocalTime.Internal,+                   Data.HodaTime.Calendar.Internal,+                   Data.HodaTime.Calendar.Gregorian.Internal,+                   Data.HodaTime.Calendar.Gregorian.CacheTable,+                   Data.HodaTime.CalendarDateTime.Internal,+                   Data.HodaTime.Instant.Internal,+                   Data.HodaTime.Instant.Clock,+                   Data.HodaTime.OffsetDateTime.Internal,+                   Data.HodaTime.TimeZone.Internal,+                   Data.HodaTime.TimeZone.Olson,+                   Data.HodaTime.ZonedDateTime.Internal++test-suite test+  default-language:+                   Haskell2010+  type:+                   exitcode-stdio-1.0+  hs-source-dirs:+                   tests+  main-is:+                   test.hs+  other-modules:+                   HodaTime.Util,+                   HodaTime.InstantTest,+                   HodaTime.LocalTimeTest,+                   HodaTime.DurationTest,+                   HodaTime.OffsetTest,+                   HodaTime.Calendar.GregorianTest,+                   HodaTime.CalendarDateTimeTest+  build-depends:+                   base >= 4 && < 5,+                   tasty >= 0.11,+                   tasty-smallcheck,+                   tasty-quickcheck,+                   tasty-hunit,+                   time,+                   bytestring,+                   hodatime++benchmark bench+  default-language:+                   Haskell2010+  type:+                   exitcode-stdio-1.0+  hs-source-dirs:+                   src,+                   bench+  main-is:+                   bench.hs+  other-modules:+                   HodaTime.OffsetBench+  build-depends:+                   base > 4,+                   criterion,+                   random+  ghc-options:+                   -Wall+                   -O2

@@ -0,0 +1,4 @@+module Data.HodaTime+(+)+where

@@ -0,0 +1,6 @@+module Data.HodaTime.Calendar.Coptic+(+)+where++-- TODO: Min start week day

@@ -0,0 +1,56 @@+module Data.HodaTime.Calendar.Gregorian+(+  -- * Constructors+   calendarDate+  ,fromNthDay+  ,fromWeekDate+  -- * Types+  ,Month(..)+  ,DayOfWeek(..)+  ,Gregorian+)+where++import Data.HodaTime.Calendar.Gregorian.Internal hiding (fromWeekDate)+import Data.HodaTime.CalendarDateTime.Internal (CalendarDate(..), DayNth, DayOfMonth, Year, WeekNumber)+import qualified Data.HodaTime.Calendar.Gregorian.Internal as GI+import Control.Monad (guard)++-- Constructors++-- | Smart constuctor for Gregorian calendar date.+calendarDate :: DayOfMonth -> Month Gregorian -> Year -> Maybe (CalendarDate Gregorian)+calendarDate d m y = do+  guard $ y > minDate+  guard $ d > 0 && d <= maxDaysInMonth m y+  let days = fromIntegral $ yearMonthDayToDays y m d+  return $ CalendarDate days (fromIntegral d) (fromIntegral . fromEnum $ m) (fromIntegral y)++-- | Smart constuctor for Gregorian calendar date based on relative month day.+fromNthDay :: DayNth -> DayOfWeek Gregorian -> Month Gregorian -> Year -> Maybe (CalendarDate Gregorian)+fromNthDay nth dow m y = do+  guard $ adjustment < fromIntegral mdim           -- NOTE: we have to use < not <= because we're adding to first of the month or subtracting from the end of the month+  return $ CalendarDate (fromIntegral days) (fromIntegral d) (fromIntegral . fromEnum $ m) (fromIntegral y)+  where+    mdim = maxDaysInMonth m y+    somDays = yearMonthDayToDays y m 1+    eomDays = yearMonthDayToDays y m mdim+    startDow = dayOfWeekFromDays days'+    targetDow = fromEnum dow+    adjustment = 7 * multiple + adjust startDow targetDow+    (days', multiple, adjust, d, days) = frontOrBack (fromEnum nth)+    frontOrBack nth'+      | nth' < 5  = (somDays, nth', weekdayDistance, adjustment + 1, somDays + adjustment)+      | otherwise = (eomDays, nth' - 5, flip weekdayDistance, mdim - adjustment, eomDays - adjustment)++-- | Smart constuctor for Gregorian calendar date based on week date.  Note that this method assumes weeks start on Sunday and the first week of the year is the one+--   which has at least one day in the new year.  For ISO compliant behavior use this constructor from the ISO module+fromWeekDate :: WeekNumber -> DayOfWeek Gregorian -> Year -> Maybe (CalendarDate Gregorian)+fromWeekDate = GI.fromWeekDate 1 Sunday++-- help functions++weekdayDistance :: (Ord a, Num a) => a -> a -> a+weekdayDistance s e = e' - s+  where+    e' = if e >= s then e else e + 7

@@ -0,0 +1,103 @@+module Data.HodaTime.Calendar.Gregorian.CacheTable+(+   DTCacheTable(..)+  ,cacheTable+  ,decodeYear+  ,decodeMonth+  ,decodeDay+  ,decodeHour+  ,decodeMinute+  ,decodeSecond+)+where++import Data.Word (Word16)+import Data.Bits (shift, (.|.), (.&.), shiftR)++type DTCacheTableDaysEntry = Word16+type DTCacheTableHoursEntry = Word16++data DTCacheTable = DTCacheTable [DTCacheTableDaysEntry] [DTCacheTableDaysEntry] [DTCacheTableHoursEntry]++cacheTable :: DTCacheTable+cacheTable = DTCacheTable days negDays hours where+  days = firstYear ++ restYears+  firstYear = [ encodeDate 0 m d | m <- [2..11], d <- daysInMonth m 0]+  restYears = [ encodeDate y m d | y <- [1..127], m <- [0..11], d <- daysInMonth m y]+  negDays = 0 : negFirstYear ++ restPrevYears                                                   -- TODO: instead of 0 it should be undefined, as this should never be accessed+  negFirstYear = [ encodeDate 0 m d | m <- [1,0], d <- reverse . daysInMonth m $ 0]+  restPrevYears = [ encodeDate y m d | y <- [1..127], m <- [11,10..0], d <- reverse . daysInMonth m $ - y]   -- NOTE: all that matters is the feb calculation which is fixed by negating the year+  hours = [ encodeTime h m s | h <- [0..11], m <- [0..59], s <- [0..59]]++-- encode++yearShift :: Num a => a+yearShift = 9++monthShift :: Num a => a+monthShift = 5++encodeDate :: Word16 -> Word16 -> Word16 -> Word16+encodeDate y m d = shift y yearShift .|. shift m monthShift .|. d++daysInMonth :: Word16 -> Word16 -> [Word16]+daysInMonth 1 y+  | isLeap                                                               = [1..29]+  | otherwise                                                            = [1..28]+  where+    y' = y + 2000+    isLeap+      | 0 == y' `mod` 100 = 0 == y' `mod` 400+      | otherwise    = 0 == y' `mod` 4+daysInMonth n _+  | n == 3 || n == 5 || n == 8 || n == 10                                = [1..30]+  | otherwise                                                            = [1..31]++hourShift :: Num a => a+hourShift = 12++minuteShift :: Num a => a+minuteShift = 6++encodeTime :: Word16 -> Word16 -> Word16 -> Word16+encodeTime h m s = shift h hourShift .|. shift m minuteShift .|. s++-- decode dates++yearMask :: Num a => a+yearMask = 65024++decodeYear :: Word16 -> Word16+decodeYear = flip shiftR yearShift . (.&.) yearMask++monthMask :: Num a => a+monthMask = 480++decodeMonth :: Word16 -> Word16+decodeMonth = flip shiftR monthShift . (.&.) monthMask++dayMask :: Num a => a+dayMask = 31++decodeDay :: Word16 -> Word16+decodeDay = (.&.) dayMask++-- decode time++hourMask :: Num a => a+hourMask = 61440++decodeHour :: Word16 -> Word16+decodeHour = flip shiftR hourShift . (.&.) hourMask++minuteMask :: Num a => a+minuteMask = 4032++decodeMinute :: Word16 -> Word16+decodeMinute = flip shiftR minuteShift . (.&.) minuteMask++secondMask :: Num a => a+secondMask = 63++decodeSecond :: Word16 -> Word16+decodeSecond = (.&.) secondMask

@@ -0,0 +1,171 @@+{-# LANGUAGE TypeFamilies #-}++module Data.HodaTime.Calendar.Gregorian.Internal+(+   daysToYearMonthDay+  ,fromWeekDate+  ,Gregorian+  ,Month(..)+  ,DayOfWeek(..)+  ,minDate+  ,epochDayOfWeek+  ,maxDaysInMonth+  ,yearMonthDayToDays+  ,dayOfWeekFromDays+)+where++import Data.HodaTime.Constants (daysPerCycle, daysPerCentury, daysPerFourYears, daysPerYear, monthDayOffsets)+import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), CalendarDate(..), DayOfMonth, Year)+import Control.Arrow ((>>>), (&&&), (***), first)+import Data.Maybe (fromJust)+import Data.List (findIndex)+import Data.HodaTime.Calendar.Gregorian.CacheTable (DTCacheTable(..), decodeMonth, decodeYear, decodeDay, cacheTable)+import Data.Int (Int32, Int8)+import Data.Word (Word8, Word32)++minDate :: Int+minDate = 1582+    +epochDayOfWeek :: DayOfWeek Gregorian+epochDayOfWeek = Wednesday+    +-- types+    +data Gregorian+    +instance IsCalendar Gregorian where+  type Date Gregorian = CalendarDate Gregorian+    +  data DayOfWeek Gregorian = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday+    deriving (Show, Eq, Ord, Enum, Bounded)+    +  data Month Gregorian = January | February | March | April | May | June | July | August | September | October | November | December+    deriving (Show, Eq, Ord, Enum, Bounded)+    +  day' f (CalendarDate _ d m y) = mkcd . (rest+) <$> f (fromIntegral d)+    where+      rest = pred $ yearMonthDayToDays (fromIntegral y) (toEnum . fromIntegral $ m) 1+      mkcd days =+        let+          days' = fromIntegral days+          (y', m', d') = daysToYearMonthDay days'+        in CalendarDate (fromIntegral days) d' m' y'+  {-# INLINE day' #-}+    +  month' (CalendarDate _ _ m _) = toEnum . fromIntegral $ m+    +  monthl' f (CalendarDate _ d m y) = mkcd <$> f (fromEnum m)+    where+      mkcd months = CalendarDate (fromIntegral days) d' (fromIntegral m') (fromIntegral y')+        where+          (y', m') = flip divMod 12 >>> first (+ fromIntegral y) $ months+          mdim = fromIntegral $ maxDaysInMonth (toEnum m') y'+          d' = if d > mdim then mdim else d+          days = yearMonthDayToDays y' (toEnum m') (fromIntegral d')+  {-# INLINE monthl' #-}+    +  year' f (CalendarDate _ d m y) = mkcd . clamp <$> f (fromIntegral y)+    where+      clamp y' = if y' < minDate then minDate else y' +      mkcd y' = CalendarDate days d' m (fromIntegral y')+        where+          m' = toEnum . fromIntegral $ m+          mdim = fromIntegral $ maxDaysInMonth m' y'+          d' = if d > mdim then mdim else d+          days = fromIntegral $ yearMonthDayToDays y' m' (fromIntegral d')+  {-# INLINE year' #-}+    +  dayOfWeek' (CalendarDate days _ _ _) = toEnum . dayOfWeekFromDays . fromIntegral $ days+    +  next' n dow (CalendarDate days _ _ _) = moveByDow n dow (-) (+) (fromIntegral days)+    +  previous' n dow (CalendarDate days _ _ _) = moveByDow n dow subtract (-) (fromIntegral days)  -- NOTE: subtract is (-) with the arguments flipped++fromWeekDate :: Int -> DayOfWeek Gregorian -> Int -> DayOfWeek Gregorian -> Year -> Maybe (Date Gregorian)+fromWeekDate minWeekDays wkStartDoW weekNum dow y = do+  return $ CalendarDate days d m y'+    where+      soyDays = yearMonthDayToDays y January minWeekDays+      soyDoW = dayOfWeekFromDays soyDays+      startDoWDistance = fromEnum soyDoW - fromEnum wkStartDoW+      dowDistance = fromEnum dow - fromEnum wkStartDoW+      dowDistance' = if dowDistance < 0 then dowDistance + 7 else dowDistance+      startDays = soyDays - startDoWDistance+      weekNum' = pred weekNum+      days = fromIntegral $ startDays + weekNum' * 7 + dowDistance'+      (y', m, d) = daysToYearMonthDay days++-- helper functions++dayOfWeekFromDays :: Int -> Int+dayOfWeekFromDays = normalize . (fromEnum epochDayOfWeek +) . flip mod 7+  where+    normalize n = if n >= 7 then n - 7 else n++moveByDow :: Int -> DayOfWeek Gregorian -> (Int -> Int -> Int) -> (Int -> Int -> Int) -> Int -> CalendarDate Gregorian+moveByDow n dow distanceF adjust days = CalendarDate days' d m y+  where+    currentDoW = dayOfWeekFromDays days+    targetDow = fromIntegral . fromEnum $ dow+    distance = distanceF targetDow currentDoW+    days' = fromIntegral $ fromIntegral days `adjust` (7 * n) `adjust` distance+    (y, m, d) = daysToYearMonthDay days'++maxDaysInMonth :: Month Gregorian -> Year -> Int+maxDaysInMonth February y+  | isLeap                                = 29+  | otherwise                             = 28+  where+    isLeap+      | 0 == y `mod` 100                  = 0 == y `mod` 400+      | otherwise                         = 0 == y `mod` 4+maxDaysInMonth n _+  | n == April || n == June || n == September || n == November  = 30+  | otherwise                                                   = 31++yearMonthDayToDays :: Year -> Month Gregorian -> DayOfMonth -> Int+yearMonthDayToDays y m d = days+  where+    m' = if m > February then fromEnum m - 2 else fromEnum m + 10+    years = if m < March then y - 2001 else y - 2000+    yearDays = years * daysPerYear + years `div` 4 + years `div` 400 - years `div` 100+    days = yearDays + monthDayOffsets !! m' + d - 1++-- | The issue is that 4 * daysPerCentury will be one less than daysPerCycle.  The reason for this is that the Gregorian calendar adds one more day per 400 year cycle+--   and this day is missing from adding up 4 individual centuries.  We have the same issue again with 4 years (i.e. 365*4 is daysPerFourYears - 1)+--   so we use this function to check if this has occurred so we can add the missing day back in.+borders :: (Num a, Eq a) => a -> a -> Bool+borders c x = x == c - 1+  +-- | Count up centuries, plus remaining days and determine if this is a special extra cycle day.  NOTE: This+--   function would be more accurate if it only took absolute values, but it does end up coming up with the correct answer even on negatives.  It just+--   ends up doing extra calculations with negatives (e.g. year comes back as -100 and entry is +100, which ends up being right but it could have been 0 and the +0 entry)+calculateCenturyDays :: Int32 -> (Int32, Int32, Bool)+calculateCenturyDays days = (y, centuryDays, isExtraCycleDay)+  where+    (cycleYears, (cycleDays, isExtraCycleDay)) = flip divMod daysPerCycle >>> (* 400) *** id &&& borders daysPerCycle $ days+    (centuryYears, centuryDays) = flip divMod daysPerCentury >>> first (* 100) $ cycleDays+    y = cycleYears + centuryYears+  +daysToYearMonthDay :: Int32 -> (Word32, Word8, Word8)+daysToYearMonthDay days = (fromIntegral y, fromIntegral m'', fromIntegral d')+  where+    (centuryYears, centuryDays, isExtraCycleDay) = calculateCenturyDays days+    (fourYears, (remaining, isLeapDay)) = flip divMod daysPerFourYears >>> (* 4) *** id &&& borders daysPerFourYears $ centuryDays+    (oneYears, yearDays) = remaining `divMod` daysPerYear+    m = pred . fromJust . findIndex (\mo -> yearDays < mo) $ monthDayOffsets+    (m', startDate) = if m >= 10 then (m - 10, 2001) else (m + 2, 2000)+    d = yearDays - monthDayOffsets !! m + 1+    (m'', d') = if isExtraCycleDay || isLeapDay then (1, 29) else (m', d)+    y = startDate + centuryYears + fourYears + oneYears+  +-- TODO: At some point we should see how much a difference the caching makes+_daysToYearMonthDay' :: Int32 -> (Int32, Int8, Int8)+_daysToYearMonthDay' days = (y',m'', fromIntegral d')+  where+    (centuryYears, centuryDays, isExtraCycleDay) = calculateCenturyDays days+    decodeEntry (DTCacheTable xs _ _) = (\x -> (decodeYear x, decodeMonth x, decodeDay x)) . (!!) xs+    (y,m,d) = decodeEntry cacheTable . fromIntegral $ centuryDays+    (m',d') = if isExtraCycleDay then (1,29) else (m,d)+    (y',m'') = (2000 + centuryYears + fromIntegral y, fromIntegral $ m')

@@ -0,0 +1,9 @@+module Data.HodaTime.Calendar.Hebrew+(+)+where++data HebrewMonthNumbering =+    HebrewCivil+  | HebrewScriptural+  deriving (Eq, Show)

@@ -0,0 +1,9 @@+{-# LANGUAGE TypeFamilies #-}++module Data.HodaTime.Calendar.Internal+(+   +)+where++-- TODO: Do we still need this?

@@ -0,0 +1,16 @@+module Data.HodaTime.Calendar.Islamic+(+)+where++data IslamicLeapYearPattern =+    ILYPBase15+  | ILYPBase16+  | ILYPIndian+  | ILYPHabashAlHasib+  deriving (Eq, Show)+    +data IslamicEpoch =+    IslamicAstronomical+  | IslamicCivil+  deriving (Eq, Show)

@@ -0,0 +1,14 @@+module Data.HodaTime.Calendar.Iso+(+  fromWeekDate+)+where++import Data.HodaTime.Calendar.Gregorian hiding (fromWeekDate)+import qualified Data.HodaTime.Calendar.Gregorian.Internal as GI+import Data.HodaTime.CalendarDateTime.Internal (CalendarDate(..), Year, WeekNumber)++-- | Smart constuctor for ISO calendar date based day within year week.  Note that this method assumes weeks start on Monday and the first week of the year is the one+--   which has at least four days in the new year.  See the Gregorian module for alternative behavior+fromWeekDate :: WeekNumber -> DayOfWeek Gregorian -> Year -> Maybe (CalendarDate Gregorian)+fromWeekDate = GI.fromWeekDate 4 Monday

@@ -0,0 +1,4 @@+module Data.HodaTime.Calendar.Persian+(+)+where

@@ -0,0 +1,12 @@+module Data.HodaTime.CalendarDate+(+   DayNth(..)+  ,Year+  ,WeekNumber+  ,DayOfMonth+  ,CalendarDate+  ,HasDate(..)+)+where++import Data.HodaTime.CalendarDateTime.Internal (CalendarDate(..), DayNth(..), DayOfMonth, Year, WeekNumber, HasDate(..))

@@ -0,0 +1,23 @@+module Data.HodaTime.CalendarDateTime+(+   DayNth(..)+  ,Year+  ,WeekNumber+  ,DayOfMonth+  ,CalendarDate+  ,CalendarDateTime+  ,IsCalendar(..)+  ,HasDate(..)+  ,LocalTime+  ,on+  ,at+)+where++import Data.HodaTime.CalendarDateTime.Internal++on :: LocalTime -> CalendarDate cal -> CalendarDateTime cal+on time date = CalendarDateTime date time++at :: CalendarDate cal -> LocalTime -> CalendarDateTime cal+at date time = CalendarDateTime date time

@@ -0,0 +1,117 @@+{-# LANGUAGE TypeFamilies #-}++module Data.HodaTime.CalendarDateTime.Internal+(+   DayNth(..)+  ,Year+  ,WeekNumber+  ,DayOfMonth+  ,CalendarDate(..)+  ,CalendarDateTime(..)+  ,IsCalendar(..)+  ,HasDate(..)+  ,LocalTime(..)+)+where++import Data.Int (Int32)+import Data.Word (Word8, Word32)++-- CalendarDate++data DayNth =+    First+  | Second+  | Third+  | Fourth+  | Fifth+  | Last+  | SecondToLast+  | ThirdToLast+  | FourthToLast+    deriving (Eq, Show, Enum)++type Year = Int+type DayOfMonth = Int+type WeekNumber = Int++-- | Represents a specific date within its calendar system, with no reference to any time zone or time of day.+-- Note: We keep the date in 2 formats, redundantly.  We depend on lazy evaluation to only produce the portion that is actually used+data CalendarDate calendar = CalendarDate { cdDays :: Int32, cdDay :: Word8, cdMonth :: Word8, cdYear :: Word32 }+  deriving (Eq, Show, Ord)  -- TODO: Get rid of Show and define the other instances to only use cdDays++-- NOTE: This is a test form of the calendar date that only stores the cycle.  Everything else will be pulled from the date cache table, as required+--data CalendarDate o calendar = CalendarDate { cdDays :: Int32, cdCycle :: Word8, ldOptions :: o }+--  deriving (Eq, Show, Ord)++class IsCalendar cal where+  type Date cal+  data DayOfWeek cal+  data Month cal+  day' :: Functor f => (DayOfMonth -> f DayOfMonth) -> CalendarDate cal -> f (CalendarDate cal)+  month' :: CalendarDate cal -> Month cal+  monthl' :: Functor f => (Int -> f Int) -> CalendarDate cal -> f (CalendarDate cal)+  year' :: Functor f => (Year -> f Year) -> CalendarDate cal -> f (CalendarDate cal)+  dayOfWeek' :: CalendarDate cal -> DayOfWeek cal+  next' :: Int -> DayOfWeek cal -> CalendarDate cal -> CalendarDate cal+  previous' :: Int -> DayOfWeek cal -> CalendarDate cal -> CalendarDate cal++class HasDate d where+  type DoW d+  type MoY d+  -- | Lens for the day component of a 'HasDate'.  Please note that days are not clamped: if you add e.g. 400 days then the month and year will roll+  day :: Functor f => (DayOfMonth -> f DayOfMonth) -> d -> f d+  -- | Accessor for the Month component of a 'HasDate'.+  month :: d -> MoY d+  -- | Lens for interacting with the month component of a 'HasDate'.  Please note that we convert the month to an Int so meaningful math can be done on it.  Also+  --   please note that the day will be unaffected except in the case of "end of month" days which may clamp.  Note that this clamping will only occur as a final step,+  --   so that+  --+  --   >>> modify (+ 2) monthl $ Gregorian.calendarDate 31 January 2000+  --   CalendarDate 31 March 2000+  --+  --   and not 29th of March as would happen with some libraries.+  monthl :: Functor f => (Int -> f Int) -> d -> f d+  -- | Lens for the year component of a 'HasDate'.  Please note that the rest of the date is left as is, with two exceptions: Feb 29 will clamp to 28 in a non-leapyear+  --   and if the new year is earlier than the earliest supported year it will clamp back to that year+  year :: Functor f => (Year -> f Year) -> d -> f d+  dayOfWeek :: d -> DoW d+  next :: Int -> DoW d -> d -> d+  previous :: Int -> DoW d -> d -> d++instance (IsCalendar cal) => HasDate (CalendarDate cal) where+  type DoW (CalendarDate cal) = DayOfWeek cal+  type MoY (CalendarDate cal) = Month cal+  day = day'+  month = month'+  monthl = monthl'+  year = year'+  dayOfWeek = dayOfWeek'+  next = next'+  previous = previous'++-- LocalTime++-- | Represents a specific time of day with no reference to any calendar, date or time zone.+data LocalTime = LocalTime { ltSecs :: Word32, ltNsecs :: Word32 }+  deriving (Eq, Ord, Show)    -- TODO: Remove Show++-- CalendarDateTime++-- | Represents a specific date and time within its calendar system.  NOTE: a CalendarDateTime does+--   *not* represent a specific time on the global time line because e.g. "10.March.2006 4pm" is a different instant+--   in most time zones.  Convert it to a ZonedDateTime first if you wish to convert to an instant (or use a convenience+--   function).+data CalendarDateTime calendar = CalendarDateTime (CalendarDate calendar) LocalTime+  deriving (Eq, Show, Ord)++instance (IsCalendar cal) => HasDate (CalendarDateTime cal) where+  type DoW (CalendarDateTime cal) = DayOfWeek cal+  type MoY (CalendarDateTime cal) = Month cal+  day f (CalendarDateTime cd lt) = flip CalendarDateTime lt <$> day f cd+  month (CalendarDateTime cd _) = month cd+  monthl f (CalendarDateTime cd lt) = flip CalendarDateTime lt <$> monthl f cd+  year f (CalendarDateTime cd lt) = flip CalendarDateTime lt <$> year f cd+  dayOfWeek (CalendarDateTime cd _) = dayOfWeek cd+  next i dow (CalendarDateTime cd lt) = CalendarDateTime (next i dow cd) lt+  previous i dow (CalendarDateTime cd lt) = CalendarDateTime (previous i dow cd) lt

@@ -0,0 +1,90 @@+module Data.HodaTime.Constants+(+   daysPerCycle+  ,daysPerCentury+  ,daysPerFourYears+  ,daysPerYear+  ,monthsPerYear+  ,daysPerWeek+  ,hoursPerDay+  ,minutesPerDay+  ,minutesPerHour+  ,secondsPerDay+  ,secondsInTwelveHours+  ,secondsPerHour+  ,secondsPerMinute+  ,millisecondsPerSecond+  ,microsecondsPerSecond+  ,nsecsPerSecond+  ,nsecsPerMicrosecond+  ,daysPerMonth+  ,monthDayOffsets+  ,unixDaysOffset+)+where++-- Time constants++daysPerCycle :: Num a => a      -- NOTE: A "cycle" is 400 years+daysPerCycle = 146097++daysPerCentury :: Num a => a+daysPerCentury = 36524++daysPerFourYears :: Num a => a+daysPerFourYears = 1461++daysPerYear :: Num a => a+daysPerYear = 365++monthsPerYear :: Num a => a+monthsPerYear = 12++daysPerWeek :: Num a => a+daysPerWeek = 7++hoursPerDay :: Num a => a+hoursPerDay = 24++minutesPerDay :: Num a => a+minutesPerDay = 1440++minutesPerHour :: Num a => a+minutesPerHour = 60++secondsPerDay :: Num a => a+secondsPerDay = 86400++secondsInTwelveHours :: Num a => a+secondsInTwelveHours = 43200++secondsPerHour :: Num a => a+secondsPerHour = 3600++secondsPerMinute :: Num a => a+secondsPerMinute = 60++millisecondsPerSecond :: Num a => a+millisecondsPerSecond = 1000++microsecondsPerSecond :: Num a => a+microsecondsPerSecond = 1000000++nsecsPerSecond :: Num a => a+nsecsPerSecond = 1000000000++nsecsPerMicrosecond :: Num a => a+nsecsPerMicrosecond = 1000++daysPerMonth :: Num a => [a]+daysPerMonth = [31, 30, 31, 30, 31, 31, 30, 31, 30, 31, 31, 28]         -- NOTE: pre-rotated++monthDayOffsets :: Num a => [a]+monthDayOffsets = 0 : rest+  where+    rest = zipWith (+) daysPerMonth (0:rest)++-- conversion constants++unixDaysOffset :: Num a => a+unixDaysOffset = 11017

@@ -0,0 +1,74 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HodaTime.Duration+-- Copyright   :  (C) 2016 Jason Johnson+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>+-- Stability   :  experimental+-- Portability :  TBD+--+-- A 'Duration' is fixed period of time between global times.+----------------------------------------------------------------------------+module Data.HodaTime.Duration+(+  -- * Types+   Duration+  -- * Constructors+  ,fromStandardWeeks+  ,fromStandardDays+  ,fromHours+  ,fromMinutes+  ,fromSeconds+  ,fromMilliseconds+  ,fromMicroseconds+  ,fromNanoseconds+  -- * Math+  ,add+  ,minus+)+where++import Data.HodaTime.Duration.Internal+import Data.HodaTime.Instant.Internal (Instant(..))+import Data.HodaTime.Instant (difference)+import qualified Data.HodaTime.Instant as I (add)+import Data.HodaTime.Constants (secondsPerDay, secondsPerHour, nsecsPerSecond)++-- | Duration of standard weeks (a standard week is assumed to be exactly 7 24 hour days)+fromStandardWeeks :: Int -> Duration+fromStandardWeeks w = fromStandardDays $ w * 7++-- | Duration of standard days (a standard day is assumed to be exactly 24 hours)+fromStandardDays :: Int -> Duration+fromStandardDays d = Duration $ Instant (fromIntegral d) 0 0++-- | Duration of hours+fromHours :: Int -> Duration+fromHours = fromSeconds . (* secondsPerHour)++-- | Duration of minutes+fromMinutes :: Int -> Duration+fromMinutes = fromSeconds . (* 60)++-- | Duration of milliseconds+fromMilliseconds :: Int -> Duration+fromMilliseconds = fromNanoseconds . (* 1000000)++-- | Duration of microseconds+fromMicroseconds :: Int -> Duration+fromMicroseconds = fromNanoseconds . (* 1000)++-- | Duration of nanoseconds+fromNanoseconds :: Int -> Duration+fromNanoseconds ns = Duration $ Instant (fromIntegral d) (fromIntegral s') (fromIntegral ns')+    where+        (s, ns') = normalize ns nsecsPerSecond+        (d, s') = normalize s secondsPerDay++-- | Add two durations together+add :: Duration -> Duration -> Duration+add (Duration instant) = Duration . I.add instant++-- | Subtract one duration from the other+minus :: Duration -> Duration -> Duration+minus (Duration linstant) (Duration rinstant) = difference linstant rinstant

@@ -0,0 +1,37 @@+module Data.HodaTime.Duration.Internal+(+   Duration(..)+  ,normalize+  ,fromSeconds+)+where++import Data.HodaTime.Instant.Internal (Instant(..))+import Control.Arrow ((>>>), (***), first)+import Data.HodaTime.Constants (secondsPerDay)++-- | Represents a duration of time between instants.  It can be from days to nanoseconds,+--   but anything longer is not representable by a duration because e.g. Months are calendar+--   specific concepts.+newtype Duration = Duration { getInstant :: Instant }+    deriving (Eq, Show)             -- TODO: Remove Show++normalize :: Int -> Int -> (Int, Int)+normalize x size+    | x >= size = pos x+    | x < 0 = neg x+    | otherwise = (0, x)+    where+        split = flip divMod size+        pos = split >>> first fromIntegral+        neg = negArrow . abs+        negAdjust = fromIntegral . negate . succ *** (+ size) . negate+        negArrow x' = let (b,s) = split x' in+          if s == 0 then (negate b,s)     -- In the case that x' splits exactly we don't need to adjust further+          else negAdjust (b,s)++-- | Duration of seconds+fromSeconds :: Int -> Duration+fromSeconds s = Duration $ Instant (fromIntegral d) (fromIntegral s') 0+    where+        (d, s') = normalize s secondsPerDay

@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HodaTime.Instant+-- Copyright   :  (C) 2016 Jason Johnson+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>+-- Stability   :  experimental+-- Portability :  TBD+--+-- An 'Instant' is universal fixed moment in time.+----------------------------------------------------------------------------+module Data.HodaTime.Instant+(+  -- * Types+   Instant+  -- * Constructors+  ,fromSecondsSinceUnixEpoch+  ,now+  -- * Math+  ,add+  ,difference+  ,minus+  -- * Conversion+  ,inUtc+  -- * Debug - to be removed+  ,LTI.fromInstant  -- TODO:  REMOVE THIS!  This is only exported for testing, remove it immediately after fixing fromSecondsSinceUnixEpoch+)+where++import Data.HodaTime.Instant.Internal+import Data.HodaTime.Instant.Clock (now)+import Data.HodaTime.Constants (secondsPerDay, nsecsPerSecond)+import Data.HodaTime.Duration.Internal (Duration(..))+import Data.HodaTime.OffsetDateTime.Internal(Offset(..))+import Data.HodaTime.TimeZone.Internal (TimeZone(..))+import Data.HodaTime.ZonedDateTime.Internal (ZonedDateTime(..))+import qualified Data.HodaTime.OffsetDateTime.Internal as Offset (empty)+import qualified Data.HodaTime.Duration.Internal as D+import qualified Data.HodaTime.LocalTime.Internal as LTI (fromInstant)++-- | Create an 'Instant' from an 'Int' that represents a Unix Epoch+fromSecondsSinceUnixEpoch :: Int -> Instant+fromSecondsSinceUnixEpoch s = fromUnixGetTimeOfDay s 0++-- | Add a 'Duration' to an 'Instant' to get a future 'Instant'. /NOTE: does not handle all negative durations, use 'minus'/+add :: Instant -> Duration -> Instant+add (Instant ldays lsecs lnsecs) (Duration (Instant rdays rsecs rnsecs)) = Instant days' secs'' nsecs'+    where+        days = ldays + rdays+        secs = lsecs + rsecs+        nsecs = lnsecs + rnsecs+        (secs', nsecs') = adjust secs nsecs nsecsPerSecond+        (days', secs'') = adjust days secs' secondsPerDay+        adjust big small size+            | small >= size = (succ big, small - size)+            | otherwise = (big, small)++-- | Get the difference between two instances+difference :: Instant -> Instant -> Duration+difference (Instant ldays lsecs lnsecs) (Instant rdays rsecs rnsecs) = Duration $ Instant days' (fromIntegral secs'') (fromIntegral nsecs')+    where+        days = ldays - rdays+        secs = (fromIntegral lsecs - fromIntegral rsecs) :: Int                   -- TODO: We should specify exactly what sizes we need here.  Keep in mind we can depend that secs and nsecs are never negative so+        nsecs = (fromIntegral lnsecs - fromIntegral rnsecs) :: Int                -- TODO: there is no worry that we get e.g. (-nsecsPerSecond - -nsecsPerSecond) causing us to have more than nsecsPerSecond.+        (secs', nsecs') = normalize nsecs secs nsecsPerSecond+        (days', secs'') = normalize secs' days secondsPerDay+        normalize x bigger size+            | x < 0 = (pred bigger, x + size)+            | otherwise = (bigger, x)++-- | Subtract a 'Duration' from an 'Instant' to get an 'Instant' in the past.  /NOTE: does not handle negative durations, use 'add'/+minus :: Instant -> Duration -> Instant+minus linstant (Duration rinstant) = getInstant $ difference linstant rinstant++-- Conversion++{-^}+-- | Create an 'OffsetDateTime' from this Instant and an Offset+withOffset :: Instant -> Offset -> Calendar -> OffsetDateTime+withOffset instant offset calendar = OffsetDateTime (LocalDateTime date time) offset          -- TODO: I'm not sure I like applying the offset on construction.  See if we can defer it+    where+        instant' = instant `add` (D.fromSeconds . fromIntegral . offsetSeconds $ offset)+        time = LTI.fromInstant instant'+        date+            | calendar == Gregorian || calendar == Iso  = GI.fromInstantInCalendar instant' calendar+            | otherwise                                 = undefined     -- TODO: Why does compiler think this isn't total without the otherwise?++-- | Convert 'Instant' Into a 'ZonedDateTime' based on the supplied 'TimeZone' and 'Calendar'+inZone :: Instant -> TimeZone -> Calendar -> ZonedDateTime+inZone instant UTCzone calendar = ZonedDateTime odt UTCzone+  where+    odt = withOffset instant Offset.empty calendar+inZone instant tzi@TimeZone { } calendar = ZonedDateTime odt tzi+    where+        odt = withOffset instant offset calendar+        offset+            | otherwise = undefined       -- TODO: When TimeZone module is implemented we can finish this (look at the olson time zone series from hackage, but we can't use it all)+-}++-- | Convert 'Instant' to a 'ZonedDateTime' in the UTC time zone, ISO calendar+inUtc :: Instant -> ZonedDateTime+inUtc instant = undefined

@@ -0,0 +1,41 @@+{-# LANGUAGE ForeignFunctionInterface #-}++#ifndef mingw32_HOST_OS+#include <sys/time.h>+#endif++module Data.HodaTime.Instant.Clock+(+    now+)+where++import Data.HodaTime.Instant.Internal (fromUnixGetTimeOfDay, Instant)++#ifdef mingw32_HOST_OS+import System.Win32.Time+#else+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.Types+import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (Ptr, nullPtr)+import Foreign.Storable+#endif++{-# INLINE now #-}+now :: IO Instant+#ifdef mingw32_HOST_OS++#else++-- | Create an 'Instant' from the current system time+now = allocaBytes #{size struct timeval} $ \ ptv -> do+  throwErrnoIfMinus1_ "gettimeofday" $ gettimeofday ptv nullPtr+  CTime sec <- #{peek struct timeval, tv_sec} ptv+  CSUSeconds usec <- #{peek struct timeval, tv_usec} ptv+  return $ fromUnixGetTimeOfDay (fromIntegral sec) (fromIntegral usec)++foreign import ccall unsafe "time.h gettimeofday"+  gettimeofday :: Ptr () -> Ptr () -> IO CInt++#endif

@@ -0,0 +1,22 @@+module Data.HodaTime.Instant.Internal+(+   Instant(..)+  ,fromUnixGetTimeOfDay+)+where++import Data.Word (Word32)+import Data.Int (Int32)+import Data.HodaTime.Constants (secondsPerDay, nsecsPerMicrosecond, unixDaysOffset)+import Control.Arrow ((>>>), first)++-- | Represents a point on a global time line.  An Instant has no concept of time zone or+--   calendar.  It is nothing more than the number of nanoseconds since epoch (1.March.2000)+data Instant = Instant { iDays :: Int32, iSecs :: Word32, iNsecs :: Word32 }                -- TODO: Would this be better with only days and Word64 Nanos?  See if the math is easier+    deriving (Eq, Ord, Show)    -- TODO: Remove Show++fromUnixGetTimeOfDay :: Int -> Word32 -> Instant+fromUnixGetTimeOfDay s ms = Instant days (fromIntegral secs) nsecs+  where+    (days, secs) = flip divMod secondsPerDay >>> first (fromIntegral . subtract unixDaysOffset) $ s+    nsecs = ms * nsecsPerMicrosecond

@@ -0,0 +1,62 @@+module Data.HodaTime.Internal+(+   secondsFromSeconds+  ,secondsFromMinutes+  ,secondsFromHours+  ,hoursFromSecs+  ,minutesFromSecs+  ,secondsFromSecs+  ,clamp+)+where++import Data.HodaTime.Constants (secondsPerHour, secondsPerMinute)++-- conversion++secondsFromSeconds :: (Integral a, Num b) => a -> b+secondsFromSeconds = fromIntegral+{-# INLINE secondsFromSeconds #-}++secondsFromMinutes :: (Integral a, Num b) => a -> b+secondsFromMinutes = fromIntegral . (*secondsPerMinute)+{-# INLINE secondsFromMinutes #-}++secondsFromHours :: (Integral a, Num b) => a -> b+secondsFromHours = fromIntegral . (*secondsPerHour)+{-# INLINE secondsFromHours #-}++-- lenses++hoursFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a+hoursFromSecs to f secs = unitFromSeconds to h r (*secondsPerHour) f+  where+    h = secs `div` secondsPerHour+    r = secs - (h*secondsPerHour)+{-# INLINE hoursFromSecs #-}++minutesFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a+minutesFromSecs to f secs = unitFromSeconds to m r (*60) f+  where+    m = secs `mod` secondsPerHour `div` 60+    r = secs - (m*60)+{-# INLINE minutesFromSecs #-}++secondsFromSecs :: (Functor f, Num b, Integral b) => (b -> a) -> (Int -> f Int) -> b -> f a+secondsFromSecs to f secs = unitFromSeconds to s r id f+  where+    s = secs `mod` 60+    r = secs - s+{-# INLINE secondsFromSecs #-}++-- utility++clamp :: Ord a => a -> a -> a -> a+clamp small big = min big . max small+{-# INLINE clamp #-}++-- helper functions++unitFromSeconds :: (Functor f, Num b, Integral b) => (b -> a) -> b -> b -> (b -> b) -> (Int -> f Int) -> f a+unitFromSeconds to unit rest fromSecs f = to . (rest+) . fromSecs . fromIntegral <$> f (fromIntegral unit)+{-# INLINE unitFromSeconds #-}

@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HodaTime.Interval+-- Copyright   :  (C) 2016 Jason Johnson+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>+-- Stability   :  experimental+-- Portability :  TBD+--+-- An 'Interval' is a period of time between two 'Instant's.+----------------------------------------------------------------------------+module Data.HodaTime.Interval+(+  -- * Types+  Interval+  -- * Constructor+  ,interval+  -- * Lenses+  ,start+  ,end+  -- * Functions+  ,contains+  ,duration+)+where++import Data.HodaTime.Instant.Internal (Instant)+import Data.HodaTime.Duration.Internal (Duration)+import Data.HodaTime.Instant (difference)++data Interval = Interval Instant Instant+    deriving (Eq, Ord, Show)    -- TODO: Remove Show++interval :: Instant -> Instant -> Interval+interval = Interval             -- TODO: We probably need some checks here++-- | Lens for the start component of the 'Interval'+start :: Functor f => (Instant -> f Instant) -> Interval -> f Interval+start f (Interval s e) = flip Interval e <$> f s+{-# INLINE start #-}++-- | Lens for the end component of the 'Interval'+end :: Functor f => (Instant -> f Instant) -> Interval -> f Interval+end f (Interval s e) = Interval s <$> f e+{-# INLINE end #-}++-- | Determines if the 'Instant' is between the start and end of the 'Interval'.  The interval includes the start but excludes the end+contains :: Interval -> Instant -> Bool+contains (Interval s e) i = s <= i && e > i++-- | Get the 'Duration' between the start and the end of the 'Interval'+duration :: Interval -> Duration+duration (Interval s e) = e `difference` s

@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HodaTime.LocalTime+-- Copyright   :  (C) 2016 Jason Johnson+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>+-- Stability   :  experimental+-- Portability :  TBD+--+-- An 'LocalTime' represents a time of day, with no reference to a particular calendar, time zone or date.+-- This module contains constructors and functions for working with 'LocalTime'.+--+-- === Normalization+--+-- A clock time can be from 00:00:00.000 to 23:59:59.99.. Adding 1 minute to 23:59:00 will cause it to roll over to 00:00:00.+----------------------------------------------------------------------------+module Data.HodaTime.LocalTime+(+   LocalTime+  ,HasLocalTime(..)+  ,Hour+  ,Minute+  ,Second+  ,Nanosecond+  ,localTime+)+where++import Data.HodaTime.LocalTime.Internal+import Data.HodaTime.Internal (secondsFromHours, secondsFromMinutes)+import Control.Monad (guard)++-- Construction++-- | Create a new 'LocalTime' from an hour, minute, second and nanosecond if values are valid, nothing otherwise+localTime :: Hour -> Minute -> Second -> Nanosecond -> Maybe LocalTime+localTime h m s ns = do+  guard $ h < 24 && h >= 0+  guard $ m < 60 && m >= 0+  guard $ s < 60 && m >= 0+  guard $ ns >= 0+  return $ LocalTime (h' + m' + fromIntegral s) (fromIntegral ns)+  where+    h' = secondsFromHours h+    m' = secondsFromMinutes m

@@ -0,0 +1,88 @@+module Data.HodaTime.LocalTime.Internal+(+   LocalTime(..)+  ,HasLocalTime(..)+  ,Hour+  ,Minute+  ,Second+  ,Nanosecond+  ,fromInstant  -- TODO: Remove+)+where++import Data.HodaTime.Instant.Internal (Instant(..))+import Data.HodaTime.CalendarDateTime.Internal (LocalTime(..), CalendarDateTime(..), CalendarDate, day, IsCalendar(..))+import Data.HodaTime.Internal (hoursFromSecs, minutesFromSecs, secondsFromSecs)+import Data.HodaTime.Constants (secondsPerDay)+import Data.Functor.Identity (Identity(..))+import Data.Word (Word32)++type Hour = Int+type Minute = Int+type Second = Int+type Nanosecond = Int++class HasLocalTime lt where+  -- | Lens for the hour component of the 'LocalTime'+  hour :: Functor f => (Hour -> f Hour) -> lt -> f lt+  -- | Lens for the minute component of the 'LocalTime'+  minute :: Functor f => (Minute -> f Minute) -> lt -> f lt+  -- | Lens for the second component of the 'LocalTime'+  second :: Functor f => (Second -> f Second) -> lt -> f lt+  -- | Lens for the nanoseconds component of the 'LocalTime'.  NOTE: no effort is made to detect nano overflow.  They will simply roll over on overflow without affecting the rest of the time.+  nanosecond :: Functor f => (Nanosecond -> f Nanosecond) -> lt -> f lt++instance HasLocalTime LocalTime where+  hour f (LocalTime secs nsecs) = hoursFromSecs to f secs+    where+      to = fromSecondsClamped nsecs+  {-# INLINE hour #-}++  minute f (LocalTime secs nsecs) = minutesFromSecs to f secs+    where+      to = fromSecondsClamped nsecs+  {-# INLINE minute #-}++  second f (LocalTime secs nsecs) = secondsFromSecs to f secs+    where+      to = fromSecondsClamped nsecs+  {-# INLINE second #-}++  nanosecond f (LocalTime secs nsecs) = LocalTime secs . fromIntegral <$> (f . fromIntegral) nsecs+  {-# INLINE nanosecond #-}++instance IsCalendar cal => HasLocalTime (CalendarDateTime cal) where+  hour f (CalendarDateTime cd (LocalTime secs nsecs)) = hoursFromSecs to f secs+    where+      to = fromSecondsRolled cd nsecs+  {-# INLINE hour #-}++  minute f (CalendarDateTime cd (LocalTime secs nsecs)) = minutesFromSecs to f secs+    where+      to = fromSecondsRolled cd nsecs+  {-# INLINE minute #-}++  second f (CalendarDateTime cd (LocalTime secs nsecs)) = secondsFromSecs to f secs+    where+      to = fromSecondsRolled cd nsecs+  {-# INLINE second #-}++  nanosecond f (CalendarDateTime cd lt) = CalendarDateTime cd <$> nanosecond f lt++-- Constructors++fromInstant :: Instant -> LocalTime                   -- NOTE: This should never go to top level as Instant -> LocalTime is not supported, you must go through a ZonedDateTime+fromInstant (Instant _ secs nsecs) = LocalTime secs nsecs++-- helper functions++fromSecondsClamped :: Word32 -> Word32 -> LocalTime+fromSecondsClamped nsecs = flip LocalTime nsecs . normalize+  where+    normalize x = if x >= secondsPerDay then x - secondsPerDay else x++fromSecondsRolled :: IsCalendar cal => CalendarDate cal -> Word32 -> Word32 -> CalendarDateTime cal+fromSecondsRolled date nsecs secs = CalendarDateTime date' $ LocalTime secs' nsecs+    where+      (d, secs') = secs `divMod` secondsPerDay+      date' = if d == 0 then date else runIdentity . day (Identity . (+ fromIntegral d)) $ date  -- NOTE: inlining the modify lens here

@@ -0,0 +1,91 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.HodaTime.Offset+-- Copyright   :  (C) 2016 Jason Johnson+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>+-- Stability   :  experimental+-- Portability :  TBD+--+-- An 'Offset' is a period of time offset from UTC time.  This module contains constructors and functions for working with 'Offsets'.+--+-- === Clamping+--+-- An offset must be between 18 hours and -18 hours (inclusive).  If you go outside this range the functions will clamp to the nearest value.+----------------------------------------------------------------------------+module Data.HodaTime.Offset+(+  -- * Types+   Offset+  -- * Constructors+  ,fromSeconds+  ,fromMinutes+  ,fromHours+  -- * Lenses+  ,seconds+  ,minutes+  ,hours+  -- * Math+  ,add+  ,minus+)+where++import Data.HodaTime.OffsetDateTime.Internal+import Data.HodaTime.Constants (secondsPerHour)+import Data.HodaTime.Internal (secondsFromSeconds, secondsFromMinutes, secondsFromHours, clamp, hoursFromSecs, minutesFromSecs, secondsFromSecs)++-- Offset specific constants++maxOffsetHours :: Num a => a+maxOffsetHours = 18++minOffsetHours :: Num a => a+minOffsetHours = negate maxOffsetHours++maxOffsetSeconds :: Num a => a+maxOffsetSeconds = maxOffsetHours * secondsPerHour++minOffsetSeconds :: Num a => a+minOffsetSeconds = negate maxOffsetSeconds++maxOffsetMinutes :: Num a => a+maxOffsetMinutes = maxOffsetHours * 60++minOffsetMinutes :: Num a => a+minOffsetMinutes = negate maxOffsetMinutes++-- | Create an 'Offset' of (clamped) s seconds.+fromSeconds :: Integral a => a -> Offset+fromSeconds = Offset . secondsFromSeconds . clamp minOffsetSeconds maxOffsetSeconds++-- | Create an 'Offset' of (clamped) m minutes.+fromMinutes :: Integral a => a -> Offset+fromMinutes = Offset . secondsFromMinutes . clamp minOffsetMinutes maxOffsetMinutes++-- | Create an 'Offset' of (clamped) h hours.+fromHours :: Integral a => a -> Offset+fromHours = Offset . secondsFromHours . clamp minOffsetHours maxOffsetHours++-- | Lens for the seconds component of the 'Offset'+seconds :: Functor f => (Int -> f Int) -> Offset -> f Offset+seconds f (Offset secs) = secondsFromSecs fromSeconds f secs+{-# INLINE seconds #-}++-- | Lens for the minutes component of the 'Offset'+minutes :: Functor f => (Int -> f Int) -> Offset -> f Offset+minutes f (Offset secs) = minutesFromSecs fromSeconds f secs+{-# INLINE minutes #-}++-- | Lens for the hours component of the 'Offset'+hours :: Functor f => (Int -> f Int) -> Offset -> f Offset+hours f (Offset secs) = hoursFromSecs fromSeconds f secs+{-# INLINE hours #-}++-- | Add one 'Offset' to another  /NOTE: if the result of the addition is outside the accepted range it will be clamped/+add :: Offset -> Offset -> Offset+add (Offset lsecs) (Offset rsecs) = fromSeconds $ lsecs + rsecs++-- | Subtract one 'Offset' to another.  /NOTE: See 'add' above/+minus :: Offset -> Offset -> Offset+minus (Offset lsecs) (Offset rsecs) = fromSeconds $ lsecs - rsecs

@@ -0,0 +1,6 @@+module Data.HodaTime.OffsetDateTime+(+)+where++import Data.HodaTime.OffsetDateTime.Internal

@@ -0,0 +1,21 @@+module Data.HodaTime.OffsetDateTime.Internal+(+   Offset(..)+  ,empty+)+where++import Data.Int (Int32)++-- | An 'Offset' from UTC in seconds.+newtype Offset = Offset { offsetSeconds :: Int32 }+    deriving (Eq, Ord, Show)     -- TODO: Remove Show++empty :: Offset+empty = Offset 0++{-+-- | A 'LocalDateTime' with a UTC offset.  This is the format used by e.g. HTTP.+data OffsetDateTime = OffsetDateTime { osdtDateTime :: LocalDateTime, osdtOffset :: Offset }+    deriving (Eq, Ord, Show)    -- TODO: Remove Show+-}

@@ -0,0 +1,64 @@+module Data.HodaTime.TimeZone+(+   utc+  ,local+  ,timeZoneAt+  ,getUtcOffset+  ,maxOffset+  ,minOffset+)+where++import Data.HodaTime.TimeZone.Internal+import Data.HodaTime.ZonedDateTime.Internal (ZonedDateTime, ZoneLocalResult(..))+import Data.HodaTime.OffsetDateTime.Internal (Offset)++utc :: TimeZone+utc = UTCzone++timeZoneAt :: TZIdentifier -> Maybe TimeZone+timeZoneAt = undefined++local :: TimeZone+local = undefined++{-+atLeniently :: LocalDateTime -> TimeZone -> ZonedDateTime+atLeniently = undefined++atStartOfDay :: LocalDate -> TimeZone -> ZonedDateTime+atStartOfDay = undefined++atStrictly :: LocalDateTime -> TimeZone -> Maybe ZonedDateTime+atStrictly ldt UTCzone = Just $ atLeniently ldt UTCzone+atStrictly _ldt _tz = undefined++-- | Return all 'ZonedDateTime' entries for a specific 'LocalDateTime' in a 'TimeZone'. Normally this would be one, but in the case that a time occurs twice in a zone (i.e. due to daylight savings time change)+-- | both would be returned.  Also, if the time does not occur at all, 'Nothing' will be returned.  This method allows the user to choose exactly what to do in the case of ambigiuty.+atAll :: LocalDateTime -> TimeZone -> Maybe ZoneLocalResult+atAll ldt UTCzone = Just . ZLSingle $ atLeniently ldt UTCzone+atAll _ldt _tz = undefined++-- | Takes two functions to determine how to resolve a 'LocalDateTime' to a 'ZonedDateTime' in the case of ambiguity or skipped times.  The first function is for the ambigous case and is past the first+-- | matching 'ZonedDateTime', followed by the second match. The second function is for the case that the 'LocalDateTime' doesn't exist in the 'TimeZone' (e.g. in a spring-forward situation, there will+-- | be a missing hour), the first 'ZonedDateTime' will be the the last time before the gap and the second will be the first time after the gap.+resolve :: LocalDateTime -> TimeZone -> (ZonedDateTime -> ZonedDateTime -> Maybe ZonedDateTime) -> (ZonedDateTime -> ZonedDateTime -> Maybe ZonedDateTime) -> Maybe ZonedDateTime+resolve ldt UTCzone _ _ = Just $ atLeniently ldt UTCzone+resolve _ldt _tz _am _sk = undefined++-- | Return a special 'ZonedDateTime' for the given 'Offset'.  The identifier will be "UTC" in the case of a zero 'Offset' and "UTC(+/-)Offset" otherwise.+forOffset :: LocalDateTime -> Offset -> TimeZone+forOffset = undefined+-}++getUtcOffset :: TimeZone -> Int+getUtcOffset UTCzone = 0+getUtcOffset _tz = undefined++maxOffset :: TimeZone -> Int+maxOffset UTCzone = 0+maxOffset _tz = undefined++minOffset :: TimeZone -> Int+minOffset UTCzone = 0+minOffset _tz = undefined

@@ -0,0 +1,48 @@+module Data.HodaTime.TimeZone.Internal+(+   TZIdentifier+  ,TransitionInfo(..)+  ,Transitions+  ,mkTransitions+  ,addTransitionInfo+  ,activeTransitionInfoFor+  ,nextTransitionInfo+  ,TimeZone(..)+)+where++import Data.Maybe (fromMaybe)+import Data.HodaTime.Instant.Internal (Instant)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as Map++newtype TZIdentifier = Zone String+  deriving (Eq, Show)++data TransitionInfo = TransitionInfo {+   ttGmtOffset :: Int+  ,ttIsDst :: Bool+  ,ttAbbreviation :: String+  ,ttIsStd :: Bool+  ,ttIsGmt :: Bool } deriving (Eq, Show)++type Transitions = Map Instant TransitionInfo++mkTransitions :: Transitions+mkTransitions = Map.empty++addTransitionInfo :: Instant -> TransitionInfo -> Transitions -> Transitions+addTransitionInfo = Map.insert++activeTransitionInfoFor :: Instant -> Transitions -> (Instant, TransitionInfo)+activeTransitionInfoFor t ts = fromMaybe (Map.findMin ts) $ Map.lookupLE t ts++nextTransitionInfo :: Instant -> Transitions -> (Instant, TransitionInfo)+nextTransitionInfo t ts = fromMaybe (Map.findMax ts) $ Map.lookupGT t ts++data TimeZone =+    UTCzone+  | TimeZone {+     tzZone :: TZIdentifier+    ,tzTransitions :: Transitions }+      deriving (Eq, Show)

@@ -0,0 +1,73 @@+module Data.HodaTime.TimeZone.Olson+(+  getTransitions+)+where++import Data.HodaTime.TimeZone.Internal++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import Data.Binary.Get (Get, getWord8, getWord32be, getByteString, runGetOrFail)+import Data.Word (Word8)+import Control.Monad (unless, replicateM_, replicateM, liftM, filterM)+import Data.Int (Int32)+import Control.Applicative ((<$>), (<*>), ZipList(..))+import Data.List (nub)+import System.Directory (doesFileExist, getDirectoryContents)+import System.FilePath ((</>))+import Data.HodaTime.Instant (fromSecondsSinceUnixEpoch)+import Data.HodaTime.Instant.Internal (Instant)++getTransitions :: L.ByteString -> Either String Transitions+getTransitions bs = case runGetOrFail getTransitions' bs of+    Left (_, _, msg) -> Left msg+    Right (_, _, xs) -> Right xs+    where+        getTransitions' = do+            magic <- (toASCII . B.unpack) <$> getByteString 4+            unless (magic == "TZif") (fail $ "unknown magic: " ++ magic)            -- We could consider creating an error type for this+            _version <- getWord8+            replicateM_ 15 getWord8 -- skip reserved section+            [ttisgmtcnt, ttisstdcnt, leapcnt, transcnt, ttypecnt, abbrlen] <- replicateM 6 get32bitInt+            transitions <- replicateM transcnt $ fromSecondsSinceUnixEpoch <$> get32bitInt+            indexes <- replicateM transcnt get8bitInt+            ttypes <- replicateM ttypecnt $ (,,) <$> get32bitInt <*> getBool <*> get8bitInt+            abbrs <- (toASCII . B.unpack) <$> getByteString abbrlen+            _leaps <- replicateM leapcnt getLeapInfo+            ttisstds <- replicateM ttisstdcnt getBool+            ttisgmts <- replicateM ttisgmtcnt getBool+            return $ zipTransitions (zipTransitionTypes abbrs ttypes ttisstds ttisgmts) transitions indexes++zipTransitionTypes :: String -> [(Int, Bool, Int)] -> [Bool] -> [Bool] -> [TransitionInfo]+zipTransitionTypes abbrs = zipWith3 toTI+    where+        toTI (gmt, isdst, offset) = TransitionInfo gmt isdst (getAbbr offset abbrs)+        getAbbr offset = takeWhile (/= '\NUL') . drop offset++zipTransitions :: [TransitionInfo] -> [Instant] -> [Int] -> Transitions+zipTransitions tis trans = foldr (\(i, idx) im -> addTransitionInfo i (tis !! idx) im) mkTransitions . zip trans++getLeapInfo :: Get (Integer, Int)+getLeapInfo = do+    lTime <- fmap toInteger get32bitInteger+    lOffset <- get32bitInt+    return (lTime, lOffset)++getBool :: Get Bool+getBool = fmap (/= 0) getWord8++get8bitInt :: Get Int+get8bitInt = fmap fromIntegral getWord8++getInt32 :: Get Int32+getInt32 = fmap fromIntegral getWord32be++get32bitInt :: Get Int+get32bitInt = fmap fromIntegral getInt32++get32bitInteger :: Get Integer+get32bitInteger = fmap fromIntegral getInt32++toASCII :: [Word8] -> String+toASCII = map (toEnum . fromIntegral)

@@ -0,0 +1,6 @@+module Data.HodaTime.ZonedDateTime+(+)+where++import Data.HodaTime.ZonedDateTime.Internal

@@ -0,0 +1,15 @@+module Data.HodaTime.ZonedDateTime.Internal+(+   ZonedDateTime(..)+  ,ZoneLocalResult(..)+)+where++import Data.HodaTime.TimeZone.Internal (TimeZone)++-- | A LocalDateTime in a specific time zone. A ZonedDateTime is global and maps directly to a single Instant.+data ZonedDateTime = ZonedDateTime { {- zdtOffsetDateTime :: OffsetDateTime, -} zdtTimeZone :: TimeZone }     -- TODO: It's not yet clear that we would need an offset time here. UPDATE: I don't want to have it, the TimeZone fulfils that role++data ZoneLocalResult =+    ZLSingle ZonedDateTime+  | ZLMulti { zlmFirst :: ZonedDateTime, zlmLast :: ZonedDateTime }

@@ -0,0 +1,94 @@+{-# LANGUAGE FlexibleInstances #-}++module HodaTime.Calendar.GregorianTest+(+  gregorianTests+)+where++import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit+import Data.Maybe (fromJust)+import Data.Time.Calendar (fromGregorianValid, toGregorian)++import HodaTime.Util+import Data.HodaTime.CalendarDate (day, monthl, month, year, next, previous, dayOfWeek)+import Data.HodaTime.Calendar.Gregorian (calendarDate, Month(..), DayOfWeek(..), Gregorian)+import qualified Data.HodaTime.Calendar.Gregorian as G+import qualified Data.HodaTime.Calendar.Iso as Iso++instance Arbitrary (Month Gregorian) where+  arbitrary = do+    x <- choose (0,11)+    return $ toEnum x++instance Arbitrary (DayOfWeek Gregorian) where+  arbitrary = do+    x <- choose (0,6)+    return $ toEnum x++gregorianTests :: TestTree+gregorianTests = testGroup "Gregorian Tests" [qcProps, unitTests]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)" [constructorProps, lensProps]++unitTests :: TestTree+unitTests = testGroup "Unit tests" [constructorUnits, lensUnits]++constructorProps :: TestTree+constructorProps = testGroup "Constructor"+  [+    QC.testProperty "same dates as Data.Time" $ testConstructor+  ]+    where+      areSame Nothing Nothing = True+      areSame (Just hdate) (Just date) =+        let+          (ty, tm, tday) = toGregorian date+        in get day hdate == tday && (convertMonth . month $ hdate) == tm && get year hdate == (fromIntegral ty)+      areSame _ _ = False+      convertMonth = succ . fromEnum+      testConstructor (Positive y) m (Positive d) = areSame (calendarDate d m y') (fromGregorianValid (fromIntegral y') (convertMonth m) d)+        where+          y' = 1900 + y++lensProps :: TestTree+lensProps = testGroup "Lens"+  [+     QC.testProperty "first day not changed by month math" $ testMonthAdd 1+    ,QC.testProperty "mid day not changed by month math" $ testMonthAdd 15+    ,QC.testProperty "dayOfWeek . next n dow $ date == dow" $ testNextDoW+    ,QC.testProperty "next n (dayOfWeek date) date == modify (+ n * 7) day date" $ testDirection next (+)+    ,QC.testProperty "previous n (dayOfWeek date) date == modify (- n * 7) day date" $ testDirection previous $ flip (-)+  ]+  where+    mkcd d m = fromJust . calendarDate d m+    testMonthAdd d (Positive y) m add = y < 400 QC.==> get day (modify (+ add) monthl $ mkcd d m (y + 1900)) == d  -- NOTE: We fix the year so we don't run out of tests+    testNextDoW dow (Positive n) = (dayOfWeek . next n dow $ epochDay) == dow+    testDirection dir adjust (Positive n) = dir n (dayOfWeek epochDay) epochDay == modify (adjust $ n * 7) day epochDay+    epochDay = mkcd 1 March 2000++constructorUnits :: TestTree+constructorUnits = testGroup "Constructor"+  [+     testCase "CalendarDate 30 February 2000 is not a valid date" $ calendarDate 30 February 2000 @?= Nothing+    ,testCase "Gregorian.fromWeekDate 1 Sunday 2000 = 26.Dec.1999" $ G.fromWeekDate 1 Sunday 2000 @?= calendarDate 26 December 1999+    ,testCase "Gregorian.fromWeekDate 5 Sunday 2000 = 23.Jan.2000" $ G.fromWeekDate 5 Sunday 2000 @?= calendarDate 23 January 2000+    ,testCase "Iso.fromWeekDate 1 Sunday 2000 = 9.Jan.2000" $ Iso.fromWeekDate 1 Sunday 2000 @?= calendarDate 9 January 2000+    ,testCase "Iso.fromWeekDate 5 Sunday 2000 = 6.Feb.2000" $ Iso.fromWeekDate 5 Sunday 2000 @?= calendarDate 6 February 2000+  ]++lensUnits :: TestTree+lensUnits = testGroup "Lens"+  [+     testCase "31-January-2000 + 2M == 31-March-2000" $ modify (+2) monthl <$> janEnd @?= calendarDate 31 March 2000+    ,testCase "31-January-2000 + 1M == 29-February-2000" $ modify (+1) monthl <$> janEnd @?= calendarDate 29 February 2000+    ,testCase "29-February-2000 + 1Y == 28-February-2001" $ modify (+1) year <$> leapFeb @?= calendarDate 28 February 2001+    ,testCase "31-December-2000 + 1D == 1-January-2001" $ modify (+1) day <$> endYear @?= calendarDate 1 January 2001+  ]+    where+      janEnd = calendarDate 31 January 2000+      leapFeb = calendarDate 29 February 2000+      endYear = calendarDate 31 December 2000

@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleInstances #-}++module HodaTime.CalendarDateTimeTest+(+  calendarDateTimeTests+)+where++import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit+import Data.Maybe (fromJust)++import HodaTime.Util+import Data.HodaTime.LocalTime (localTime, HasLocalTime(..))+import Data.HodaTime.CalendarDate (day, monthl, month, year, next, previous, dayOfWeek)+import Data.HodaTime.Calendar.Gregorian (calendarDate, Month(..), DayOfWeek(..), Gregorian)+import Data.HodaTime.CalendarDateTime (on, at)++calendarDateTimeTests :: TestTree+calendarDateTimeTests = testGroup "CalendarDateTimeTests Tests" [qcProps, unitTests]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)" [timeLensProps, dateLensProps]++unitTests :: TestTree+unitTests = testGroup "Unit tests" [rolloverUnits]++timeLensProps :: TestTree+timeLensProps = testGroup "Time Lens"+  [+     QC.testProperty "get seconds offset" $ testGet second _1+    ,QC.testProperty "get minutes offset" $ testGet minute _2+    ,QC.testProperty "get hours offset" $ testGet hour _3+    ,QC.testProperty "modify seconds offset" $ testF (modify . (+)) second _1 (+) 5+    ,QC.testProperty "modify minutes offset" $ testF (modify . (+)) minute _2 (+) 5+    ,QC.testProperty "modify hours offset" $ testF (modify . (+)) hour _3 (+) 5+    ,QC.testProperty "set seconds offset" $ testF set second _1 const 5+    ,QC.testProperty "set minutes offset" $ testF set minute _2 const 5+    ,QC.testProperty "set hours offset" $ testF set hour _3 const 5+  ]+  where+    mkTime h m s = fromJust $ on <$> localTime h m s 0 <*> calendarDate 1 April 2001   -- We are already controlling that only valid values will be passed in+    offsetEq (s, m, h) off = get second off == s && get minute off == m && get hour off == h+    _1 f (a,b,c) = (\a' -> (a',b,c)) <$> f a+    _2 f (a,b,c) = (\b' -> (a,b',c)) <$> f b+    _3 f (a,b,c) = (\c' -> (a,b,c')) <$> f c+    testGet l l' (Positive s, Positive m, Positive h) = h < 23 && s < 60 && m < 60 QC.==> get l (mkTime h m s) == get l' (s, m, h)+    testF f l l' g n (Positive s, Positive m, Positive h) = h < 23 - n && s < 60 - n && m < 60 - n QC.==> offsetEq (modify (g n) l' (s,m,h)) $ f n l (mkTime h m s)++instance Arbitrary (Month Gregorian) where+  arbitrary = do+    x <- choose (0,11)+    return $ toEnum x++instance Arbitrary (DayOfWeek Gregorian) where+  arbitrary = do+    x <- choose (0,6)+    return $ toEnum x++dateLensProps :: TestTree+dateLensProps = testGroup "Date Lens"+  [+     QC.testProperty "first day not changed by month math" $ testMonthAdd 1+    ,QC.testProperty "mid day not changed by month math" $ testMonthAdd 15+    ,QC.testProperty "dayOfWeek . next n dow $ date == dow" $ testNextDoW+    ,QC.testProperty "next n (dayOfWeek date) date == modify (+ n * 7) day date" $ testDirection next (+)+    ,QC.testProperty "previous n (dayOfWeek date) date == modify (- n * 7) day date" $ testDirection previous $ flip (-)+  ]+    where+      mkcd d m y = fromJust $ on <$> localTime 10 10 10 0 <*> calendarDate d m y+      testMonthAdd d (Positive y) m add = y < 400 QC.==> get day (modify (+ add) monthl $ mkcd d m (y + 1900)) == d  -- NOTE: We fix the year so we don't run out of tests+      testNextDoW dow (Positive n) = (dayOfWeek . next n dow $ epochDay) == dow+      testDirection dir adjust (Positive n) = dir n (dayOfWeek epochDay) epochDay == modify (adjust $ n * 7) day epochDay+      epochDay = mkcd 1 March 2000++rolloverUnits :: TestTree+rolloverUnits = testGroup "Rollover"+  [+     testCase "30.Jan.2000 22:57:57 + 2s == 30.Jan.2000 22:57:59" $ modify (+2) second <$> dt @?= mkLT 22 57 59 0+    ,testCase "30.Jan.2000 22:57:57 + 5s == 30.Jan.2000 22:58:02" $ modify (+5) second <$> dt @?= mkLT 22 58 2 0+    ,testCase "30.Jan.2000 22:57:57 + 5m == 30.Jan.2000 23:02:57" $ modify (+5) minute <$> dt @?= mkLT 23 02 57 0+    ,testCase "30.Jan.2000 22:57:57 + 3h == 31.Jan.2000 01:57:57" $ modify (+3) hour <$> dt @?= mkLTWithRolledDate 1 57 57 0+    ,testCase "30.Jan.2000 22:57:57 + 3723s == 31.Jan.2000 00:00:00" $ modify (+3723) second <$> dt @?= mkLTWithRolledDate 0 0 0 0+    ,testCase "30.Jan.2000 22:57:57 + 3725s == 31.Jan.2000 00:00:02" $ modify (+3725) second <$> dt @?= mkLTWithRolledDate 0 0 2 0+    ,testCase "30.Jan.2000 22:57:57 + 48h == 1.Feb.2000 22:57:57" $ modify (+48) hour <$> dt @?= mkLTWithDate monthRoll 22 57 57 0+  ]+  where+    time = localTime 22 57 57 0+    date = calendarDate 30 January 2000+    rollDate = calendarDate 31 January 2000+    monthRoll = calendarDate 1 February 2000+    dt = on <$> time <*> date+    mkLTWithDate date' h m s n = on <$> localTime h m s n <*> date'+    mkLT = mkLTWithDate date+    mkLTWithRolledDate = mkLTWithDate rollDate

@@ -0,0 +1,71 @@+module HodaTime.DurationTest+(+  durationTests+)+where++import Test.Tasty+import Test.Tasty.QuickCheck as QC++import Data.HodaTime.Duration++-- Tests++durationTests :: TestTree+durationTests = testGroup "Duration Tests" [qcProps]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)" [nanoSecProps, secondProps, dayProps, mathProps]++-- Properties++nanoSecProps :: TestTree+nanoSecProps = testGroup "Nanoseconds conversion"+  [+     QC.testProperty "fromNanoseconds (x * 1000) == fromMicroseconds x" $ test fromMicroseconds micro+    ,QC.testProperty "fromNanoseconds (x * 1000 * 1000) == fromMilliseconds x" $ test fromMilliseconds milli+    ,QC.testProperty "fromNanoseconds (x * 1000 * 1000 * 1000) == fromSeconds x" $ test fromSeconds sec+  ]+  where+    test = test_from fromNanoseconds+    micro = 1000+    milli = micro*1000+    sec = milli*1000++secondProps :: TestTree+secondProps = testGroup "Seconds conversion"+  [+     QC.testProperty "fromSeconds (x * 60) == fromMinutes x" $ test fromMinutes mins+    ,QC.testProperty "fromSeconds (x * 60 * 60) == fromHours x" $ test fromHours hours+    ,QC.testProperty "fromSeconds (x * 60 * 60 * 24) == fromStandardDays x" $ test fromStandardDays sdays+    ,QC.testProperty "fromSeconds (x * 60 * 60 * 24 * 7) == fromStandardWeeks x" $ test fromStandardWeeks sweeks+  ]+  where+    test = test_from fromSeconds+    mins = 60+    hours = mins*60+    sdays = hours*24+    sweeks = sdays*7++dayProps :: TestTree+dayProps = testGroup "Days conversion"+  [+    QC.testProperty "fromStandardDays (x * 7) == fromStandardWeeks x" $ test fromStandardWeeks sweeks+  ]+  where+    test = test_from fromStandardDays+    sweeks = 7++mathProps :: TestTree+mathProps = testGroup "Math"+  [+     QC.testProperty "fromNanoseconds x `add` fromNanoseconds y == fromNanoseconds (x+y)" $ test add (+)+    ,QC.testProperty "fromNanoseconds x `minus` fromNanoseconds y == fromNanoseconds (x-y)" $ test minus (-)+  ]+  where+    test f g (Positive x) (Positive y) = fromNanoseconds x `f` fromNanoseconds y == fromNanoseconds (g x y)++-- helper functions++test_from :: (Int -> Duration) -> (Int -> Duration) -> Int -> Int -> Bool+test_from g f y x = f x == g (y*x)

@@ -0,0 +1,35 @@+module HodaTime.InstantTest+(+  instantTests+)+where++import Test.Tasty+import Test.Tasty.HUnit++import Data.HodaTime.Instant (fromSecondsSinceUnixEpoch, fromInstant)+import Data.HodaTime.LocalTime (HasLocalTime(..))+import Control.Applicative (Const(..))+import Data.Time.Clock.POSIX (getPOSIXTime, posixSecondsToUTCTime)+import Data.Time.LocalTime (todHour, todMin, todSec, hoursToTimeZone, utcToLocalTime, LocalTime(..))++instantTests :: TestTree+instantTests = testGroup "Instant Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [+     testCase "test_fromSecondsSinceUnixEpoch" test_fromSecondsSinceUnixEpoch+  ]++test_fromSecondsSinceUnixEpoch :: Assertion  -- TODO: this is temporary until we get the required infrastructure in place to properly test Instants (we can't now because there is no legal conversion, only the internal fromInstant function)+test_fromSecondsSinceUnixEpoch = do+  posT <- getPOSIXTime+  let secs = round posT+      lt = fromInstant . fromSecondsSinceUnixEpoch $ secs+      utc = posixSecondsToUTCTime posT+      (LocalTime _ tod) = utcToLocalTime (hoursToTimeZone 0) utc+      get l = getConst . l Const+  assertEqual "hours: " (get hour lt) (todHour tod)+  assertEqual "minutes: " (get minute lt) (todMin tod)+  assertEqual "seconds: " (get second lt) (round . todSec $ tod)

@@ -0,0 +1,61 @@+module HodaTime.LocalTimeTest+(+  localTimeTests+)+where++import Test.Tasty+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit+import Data.Maybe (fromJust)++import HodaTime.Util+import Data.HodaTime.LocalTime (localTime, HasLocalTime(..))++localTimeTests :: TestTree+localTimeTests = testGroup "LocalTime Tests" [qcProps, unitTests]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)" [lensProps]++unitTests :: TestTree+unitTests = testGroup "Unit tests" [rolloverUnits]++-- properties++lensProps :: TestTree+lensProps = testGroup "Lens"+  [+     QC.testProperty "get seconds offset" $ testGet second _1+    ,QC.testProperty "get minutes offset" $ testGet minute _2+    ,QC.testProperty "get hours offset" $ testGet hour _3+    ,QC.testProperty "modify seconds offset" $ testF (modify . (+)) second _1 (+) 5+    ,QC.testProperty "modify minutes offset" $ testF (modify . (+)) minute _2 (+) 5+    ,QC.testProperty "modify hours offset" $ testF (modify . (+)) hour _3 (+) 5+    ,QC.testProperty "set seconds offset" $ testF set second _1 const 5+    ,QC.testProperty "set minutes offset" $ testF set minute _2 const 5+    ,QC.testProperty "set hours offset" $ testF set hour _3 const 5+  ]+  where+    mkTime h m s = fromJust . localTime h m s $ 0    -- We are already controlling that only valid values will be passed in+    offsetEq (s, m, h) off = get second off == s && get minute off == m && get hour off == h+    _1 f (a,b,c) = (\a' -> (a',b,c)) <$> f a+    _2 f (a,b,c) = (\b' -> (a,b',c)) <$> f b+    _3 f (a,b,c) = (\c' -> (a,b,c')) <$> f c+    testGet l l' (Positive s, Positive m, Positive h) = h < 23 && s < 60 && m < 60 QC.==> get l (mkTime h m s) == get l' (s, m, h)+    testF f l l' g n (Positive s, Positive m, Positive h) = h < 23 - n && s < 60 - n && m < 60 - n QC.==> offsetEq (modify (g n) l' (s,m,h)) $ f n l (mkTime h m s)++rolloverUnits :: TestTree+rolloverUnits = testGroup "Rollover"+  [+     testCase "22:57:57 + 2s == 22:57:59" $ modify (+2) second <$> time @?= localTime 22 57 59 0+    ,testCase "22:57:57 + 5s == 22:58:02" $ modify (+5) second <$> time @?= localTime 22 58 2 0+    ,testCase "22:57:57 + 2m == 22:59:57" $ modify (+2) minute <$> time @?= localTime 22 59 57 0+    ,testCase "22:57:57 + 5m == 23:02:57" $ modify (+5) minute <$> time @?= localTime 23 02 57 0+    ,testCase "22:57:57 + 1h == 23:57:57" $ modify (+1) hour <$> time @?= localTime 23 57 57 0+    ,testCase "22:57:57 + 3h == 01:57:57" $ modify (+3) hour <$> time @?= localTime 1 57 57 0+    ,testCase "22:57:57 + 3723s == 00:00:00" $ modify (+3723) second <$> time @?= localTime 0 0 0 0+    ,testCase "22:57:57 + 3725s == 00:00:02" $ modify (+3725) second <$> time @?= localTime 0 0 2 0+  ]+  where+    time = localTime 22 57 57 0

@@ -0,0 +1,93 @@+module HodaTime.OffsetTest+(+  offsetTests+)+where++import Test.Tasty+import Test.Tasty.SmallCheck as SC+import Test.Tasty.QuickCheck as QC+import Test.Tasty.HUnit++import Data.HodaTime.Offset+import Control.Applicative (Const(..))+import Data.Functor.Identity (Identity(..))++offsetTests :: TestTree+offsetTests = testGroup "Offset Tests" [scProps, qcProps, unitTests]++-- top level tests++scProps :: TestTree+scProps = testGroup "(checked by SmallCheck)" [mathPropSC]++qcProps :: TestTree+qcProps = testGroup "(checked by QuickCheck)" [secondProps, mathProps, lensProps]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [+  ]++-- properties++mathPropSC :: TestTree+mathPropSC = localOption (SmallCheckDepth 18) $ testGroup "Math"  -- NOTE: Max offset size is 18/-18 so we set the depth to make sure everything in that range is tested+  [+     SC.testProperty "fromHours x `add` fromHours y == fromHours (x+y)" $ test fromHours add (+)+    ,SC.testProperty "fromHours x `minus` fromHours y == fromHours (x-y)" $ test fromHours minus (-)+  ]++secondProps :: TestTree+secondProps = testGroup "Seconds conversion"+  [+     QC.testProperty "fromSeconds (x * 60) == fromMinutes x" $ testS fromMinutes mins+    ,QC.testProperty "fromSeconds (x * 60 * 60) == fromHours x" $ testS fromHours hrs+  ]+  where+    testS = test_from fromSeconds+    mins = 60+    hrs = mins*60++mathProps :: TestTree+mathProps = testGroup "Math"+  [+     QC.testProperty "fromSeconds x `add` fromSeconds y == fromSeconds (x+y)" $ test fromSeconds add (+)+    ,QC.testProperty "fromSeconds x `minus` fromSeconds y == fromSeconds (x-y)" $ test fromSeconds minus (-)+    ,QC.testProperty "fromMinutes x `add` fromMinutes y == fromMinutes (x+y)" $ test fromMinutes add (+)+    ,QC.testProperty "fromMinutes x `minus` fromMinutes y == fromMinutes (x-y)" $ test fromMinutes minus (-)+  ]++lensProps :: TestTree+lensProps = testGroup "Lens"+  [+     QC.testProperty "get seconds offset" $ testGet seconds _1+    ,QC.testProperty "get minutes offset" $ testGet minutes _2+    ,QC.testProperty "get hours offset" $ testGet hours _3+    ,QC.testProperty "modify seconds offset" $ testF (modify . (+)) seconds _1 (+) 5+    ,QC.testProperty "modify minutes offset" $ testF (modify . (+)) minutes _2 (+) 5+    ,QC.testProperty "modify hours offset" $ testF (modify . (+)) hours _3 (+) 5+    ,QC.testProperty "set seconds offset" $ testF setL seconds _1 const 5+    ,QC.testProperty "set minutes offset" $ testF setL minutes _2 const 5+    ,QC.testProperty "set hours offset" $ testF setL hours _3 const 5+  ]+  where+    offset :: Int -> Int -> Int -> Offset   -- Only needed so the compiler can decide which concreate type to use+    offset s m h = fromSeconds s `add` fromMinutes m `add` fromHours h+    offsetEq (s, m, h) off = get seconds off == s && get minutes off == m && get hours off == h+    _1 f (a,b,c) = (\a' -> (a',b,c)) <$> f a+    _2 f (a,b,c) = (\b' -> (a,b',c)) <$> f b+    _3 f (a,b,c) = (\c' -> (a,b,c')) <$> f c+    get l = getConst . l Const+    modify f l = runIdentity . l (Identity . f)+    setL v = modify (const v)+    testGet l l' (Positive s, Positive m, Positive h) = h < 18 && s < 60 && m < 60 QC.==> get l (offset s m h) == get l' (s, m, h)      -- TODO: Why no negative?+    testF f l l' g n (Positive s, Positive m, Positive h) = h < 18 - n && s < 60 - n && m < 60 - n QC.==> offsetEq (modify (g n) l' (s,m,h)) $ f n l (offset s m h)++-- helper functions++test :: (Int -> Offset) -> (Offset -> Offset -> Offset) -> (Int -> Int -> Int) -> Int -> Int -> Bool+test f g h x y = f x `g` f y == f (h x y)++test_from :: (Int -> Offset) -> (Int -> Offset) -> Int -> Int -> Bool+test_from g f y x = f x == g (y*x)

@@ -0,0 +1,21 @@+module HodaTime.Util+(+   get+  ,modify+  ,set+)+where++import Control.Applicative (Const(..))+import Data.Functor.Identity (Identity(..))++-- Lenses++get :: ((s -> Const s c) -> a -> Const t b) -> a -> t+get l = getConst . l Const+  +modify :: (s -> b) -> ((s -> Identity b) -> a -> Identity t) -> a -> t+modify f l = runIdentity . l (Identity . f)+  +set :: s -> ((b -> Identity s) -> a -> Identity t) -> a -> t+set v = modify (const v)

@@ -0,0 +1,26 @@+import Test.Tasty++import HodaTime.InstantTest+import HodaTime.DurationTest+import HodaTime.OffsetTest+import HodaTime.LocalTimeTest+import HodaTime.Calendar.GregorianTest+import HodaTime.CalendarDateTimeTest++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [instantTests, durationTests, offsetTests, localTimeTests, gregorianTests, calendarDateTimeTests]++{-+unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [ testCase "List comparison (different length)" $+      [1, 2, 3] `compare` [1,2] @?= GT++  -- the following test does not hold+  , testCase "List comparison (same length)" $+      [1, 2, 3] `compare` [1,2,2] @?= LT+  ]+-}