    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    #include "thyme.h"

    -- | 'UTCTime' is not Y294K-compliant, and 'Bounded' instances for the
    -- various calendar types reflect this fact. That said, the calendar
    -- calculations by themselves work perfectly fine for a wider range of
    -- dates, subject to the size of 'Int' for your platform.
    module Data.Thyme.Calendar
        ( Years, Months, Days
        -- * Days
        , Day (..), modifiedJulianDay
        -- * Gregorian calendar
        , Year, Month, DayOfMonth
        , YearMonthDay (..)
        , isLeapYear
        , yearMonthDay, gregorian, gregorianValid, showGregorian
        , module Data.Thyme.Calendar
        ) where

    import Prelude hiding ((.))
    import Control.Applicative
    import Control.Arrow
    import Control.Category
    import Control.Lens
    import Control.Monad
    import Data.AdditiveGroup
    import Data.Thyme.Calendar.Internal
    import Data.Thyme.Clock.Internal
    import System.Random
    import Test.QuickCheck

    -- "Data.Thyme.Calendar.Internal" cannot import "Data.Thyme.Clock.Internal",
    -- therefore these orphan 'Bounded' instances must live here.
    instance Bounded Day where
        minBound :: Day
    minBound = UTCTime
    forall a. Bounded a => a
    minBound UTCTime -> Getting Day UTCTime Day -> Day
    forall s a. s -> Getting a s a -> a
    ^. Getting Day UTCTime Day
    Lens' UTCTime Day
    _utctDay
        maxBound :: Day
    maxBound = UTCTime
    forall a. Bounded a => a
    maxBound UTCTime -> Getting Day UTCTime Day -> Day
    forall s a. s -> Getting a s a -> a
    ^. Getting Day UTCTime Day
    Lens' UTCTime Day
    _utctDay

    instance Bounded YearMonthDay where
        minBound :: YearMonthDay
    minBound = Day
    forall a. Bounded a => a
    minBound Day -> Getting YearMonthDay Day YearMonthDay -> YearMonthDay
    forall s a. s -> Getting a s a -> a
    ^. Getting YearMonthDay Day YearMonthDay
    Iso' Day YearMonthDay
    gregorian
        maxBound :: YearMonthDay
    maxBound = Day
    forall a. Bounded a => a
    maxBound Day -> Getting YearMonthDay Day YearMonthDay -> YearMonthDay
    forall s a. s -> Getting a s a -> a
    ^. Getting YearMonthDay Day YearMonthDay
    Iso' Day YearMonthDay
    gregorian

    instance Random Day where
        randomR :: (Day, Day) -> g -> (Day, g)
    randomR r :: (Day, Day)
    r = (UTCTime -> Day) -> (UTCTime, g) -> (Day, g)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (UTCTime -> Getting Day UTCTime Day -> Day
    forall s a. s -> Getting a s a -> a
    ^. Getting Day UTCTime Day
    Lens' UTCTime Day
    _utctDay) ((UTCTime, g) -> (Day, g)) -> (g -> (UTCTime, g)) -> g -> (Day, g)
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (UTCTime, UTCTime) -> g -> (UTCTime, g)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR ((Day, Day) -> (UTCTime, UTCTime)
    range (Day, Day)
    r) where
            -- upper bound is one Micro second before the next day
            range :: (Day, Day) -> (UTCTime, UTCTime)
    range = Day -> UTCTime
    toMidnight (Day -> UTCTime)
    -> (Day -> UTCTime) -> (Day, Day) -> (UTCTime, UTCTime)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** UTCTime -> UTCTime
    forall a. Enum a => a -> a
    pred (UTCTime -> UTCTime) -> (Day -> UTCTime) -> Day -> UTCTime
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Day -> UTCTime
    toMidnight (Day -> UTCTime) -> (Day -> Day) -> Day -> UTCTime
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Day -> Day
    forall a. Enum a => a -> a
    succ
            toMidnight :: Day -> UTCTime
    toMidnight = (Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
    Iso' UTCTime UTCView
    utcTime Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
    -> UTCView -> UTCTime
    forall s t a b. AReview s t a b -> b -> t
    #) (UTCView -> UTCTime) -> (Day -> UTCView) -> Day -> UTCTime
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Day -> DiffTime -> UTCView) -> DiffTime -> Day -> UTCView
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Day -> DiffTime -> UTCView
    UTCTime DiffTime
    forall v. AdditiveGroup v => v
    zeroV
        random :: g -> (Day, g)
    random = (Day, Day) -> g -> (Day, g)
    forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
    randomR (Day
    forall a. Bounded a => a
    minBound, Day
    forall a. Bounded a => a
    maxBound)

    instance Random YearMonthDay where
        randomR :: (YearMonthDay, YearMonthDay) -> g -> (YearMonthDay, g)
    randomR = Iso' Day YearMonthDay
    -> (YearMonthDay, YearMonthDay) -> g -> (YearMonthDay, g)
    forall s g a.
    (Random s, RandomGen g) =>
    Iso' s a -> (a, a) -> g -> (a, g)
    randomIsoR Iso' Day YearMonthDay
    gregorian
        random :: g -> (YearMonthDay, g)
    random = (Day -> YearMonthDay) -> (Day, g) -> (YearMonthDay, g)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (Day -> Getting YearMonthDay Day YearMonthDay -> YearMonthDay
    forall s a. s -> Getting a s a -> a
    ^. Getting YearMonthDay Day YearMonthDay
    Iso' Day YearMonthDay
    gregorian) ((Day, g) -> (YearMonthDay, g))
    -> (g -> (Day, g)) -> g -> (YearMonthDay, g)
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . g -> (Day, g)
    forall a g. (Random a, RandomGen g) => g -> (a, g)
    random

    instance Arbitrary Day where
        arbitrary :: Gen Day
    arbitrary = Int -> Day
    ModifiedJulianDay
            (Int -> Day) -> Gen Int -> Gen Day
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int, Int) -> Gen Int
    forall a. Random a => (a, a) -> Gen a
    choose (((Day -> Int) -> (Day -> Int) -> (Day, Day) -> (Int, Int))
    -> (Day -> Int) -> (Day, Day) -> (Int, Int)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (Day -> Int) -> (Day -> Int) -> (Day, Day) -> (Int, Int)
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    (***) Day -> Int
    toModifiedJulianDay (Day
    forall a. Bounded a => a
    minBound, Day
    forall a. Bounded a => a
    maxBound))
        shrink :: Day -> [Day]
    shrink (ModifiedJulianDay mjd :: Int
    mjd) = Int -> Day
    ModifiedJulianDay (Int -> Day) -> [Int] -> [Day]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> [Int]
    forall a. Arbitrary a => a -> [a]
    shrink Int
    mjd

    instance Arbitrary YearMonthDay where
        arbitrary :: Gen YearMonthDay
    arbitrary = Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
    forall a s. Getting a s a -> s -> a
    view Getting YearMonthDay Day YearMonthDay
    Iso' Day YearMonthDay
    gregorian (Day -> YearMonthDay) -> Gen Day -> Gen YearMonthDay
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Gen Day
    forall a. Arbitrary a => Gen a
    arbitrary
        shrink :: YearMonthDay -> [YearMonthDay]
    shrink ymd :: YearMonthDay
    ymd = Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
    forall a s. Getting a s a -> s -> a
    view Getting YearMonthDay Day YearMonthDay
    Iso' Day YearMonthDay
    gregorian (Day -> YearMonthDay) -> [Day] -> [YearMonthDay]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Day -> [Day]
    forall a. Arbitrary a => a -> [a]
    shrink (Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
    Iso' Day YearMonthDay
    gregorian Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
    -> YearMonthDay -> Day
    forall s t a b. AReview s t a b -> b -> t
    # YearMonthDay
    ymd)

    instance CoArbitrary YearMonthDay where
        coarbitrary :: YearMonthDay -> Gen b -> Gen b
    coarbitrary (YearMonthDay y :: Int
    y m :: Int
    m d :: Int
    d)
            = Int -> Gen b -> Gen b
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
    coarbitrary Int
    y (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Int -> Gen b -> Gen b
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
    coarbitrary Int
    m (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Int -> Gen b -> Gen b
    forall a b. CoArbitrary a => a -> Gen b -> Gen b
    coarbitrary Int
    d

    ------------------------------------------------------------------------

    {-# INLINE gregorianMonthLength #-}
    gregorianMonthLength :: Year -> Month -> Days
    gregorianMonthLength :: Int -> Int -> Int
    gregorianMonthLength = Bool -> Int -> Int
    monthLength (Bool -> Int -> Int) -> (Int -> Bool) -> Int -> Int -> Int
    forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . Int -> Bool
    isLeapYear

    {-# INLINEABLE gregorianMonthsClip #-}
    gregorianMonthsClip :: Months -> YearMonthDay -> YearMonthDay
    gregorianMonthsClip :: Int -> YearMonthDay -> YearMonthDay
    gregorianMonthsClip n :: Int
    n (YearMonthDay y :: Int
    y m :: Int
    m d :: Int
    d) = Int -> Int -> Int -> YearMonthDay
    YearMonthDay Int
    y' Int
    m'
            (Int -> YearMonthDay) -> Int -> YearMonthDay
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min (Int -> Int -> Int
    gregorianMonthLength Int
    y' Int
    m') Int
    d where
        (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    y -> Int
    y', Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) 1 -> Int
    m') = Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    divMod (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) 12

    {-# ANN gregorianMonthsRollover "HLint: ignore Use if" #-}
    {-# INLINEABLE gregorianMonthsRollover #-}
    gregorianMonthsRollover :: Months -> YearMonthDay -> YearMonthDay
    gregorianMonthsRollover :: Int -> YearMonthDay -> YearMonthDay
    gregorianMonthsRollover n :: Int
    n (YearMonthDay y :: Int
    y m :: Int
    m d :: Int
    d) = case Int
    d Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    len of
        True -> Int -> Int -> Int -> YearMonthDay
    YearMonthDay Int
    y' Int
    m' Int
    d
        False -> case Int
    m' Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 12 of
            True -> Int -> Int -> Int -> YearMonthDay
    YearMonthDay Int
    y' (Int
    m' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) (Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    len)
            False -> Int -> Int -> Int -> YearMonthDay
    YearMonthDay (Int
    y' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + 1) 1 (Int
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    len)
      where
        (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    y -> Int
    y', Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) 1 -> Int
    m') = Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    divMod (Int
    m Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) 12
        len :: Int
    len = Int -> Int -> Int
    gregorianMonthLength Int
    y' Int
    m'

    {-# INLINEABLE gregorianYearsClip #-}
    gregorianYearsClip :: Years -> YearMonthDay -> YearMonthDay
    gregorianYearsClip :: Int -> YearMonthDay -> YearMonthDay
    gregorianYearsClip n :: Int
    n (YearMonthDay (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    n -> Int
    y') 2 29)
        | Bool -> Bool
    not (Int -> Bool
    isLeapYear Int
    y') = Int -> Int -> Int -> YearMonthDay
    YearMonthDay Int
    y' 2 28
    gregorianYearsClip n :: Int
    n (YearMonthDay y :: Int
    y m :: Int
    m d :: Int
    d) = Int -> Int -> Int -> YearMonthDay
    YearMonthDay (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int
    m Int
    d

    {-# INLINEABLE gregorianYearsRollover #-}
    gregorianYearsRollover :: Years -> YearMonthDay -> YearMonthDay
    gregorianYearsRollover :: Int -> YearMonthDay -> YearMonthDay
    gregorianYearsRollover n :: Int
    n (YearMonthDay (Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    n -> Int
    y') 2 29)
        | Bool -> Bool
    not (Int -> Bool
    isLeapYear Int
    y') = Int -> Int -> Int -> YearMonthDay
    YearMonthDay Int
    y' 3 1
    gregorianYearsRollover n :: Int
    n (YearMonthDay y :: Int
    y m :: Int
    m d :: Int
    d) = Int -> Int -> Int -> YearMonthDay
    YearMonthDay (Int
    y Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    n) Int
    m Int
    d

    -- * Lenses
    LENS(YearMonthDay,ymdYear,Year)
    LENS(YearMonthDay,ymdMonth,Month)
    LENS(YearMonthDay,ymdDay,DayOfMonth)