{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

#include "thyme.h"
#if HLINT
#include "cabal_macros.h"
#endif

-- | ISO 8601 Ordinal Date format
module Data.Thyme.Calendar.OrdinalDate
    ( Year, isLeapYear
    , DayOfYear
    , OrdinalDate (..), _odYear, _odDay
    , ordinalDate
    , module Data.Thyme.Calendar.OrdinalDate
    ) where

import Prelude
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Arrow
import Control.Lens
import Control.Monad
import Data.Thyme.Calendar
import Data.Thyme.Calendar.Internal
import System.Random
import Test.QuickCheck

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

instance Random OrdinalDate where
    randomR :: forall g.
RandomGen g =>
(OrdinalDate, OrdinalDate) -> g -> (OrdinalDate, g)
randomR = Iso' Day OrdinalDate
-> (OrdinalDate, OrdinalDate) -> g -> (OrdinalDate, g)
forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Overloaded p f Day Day OrdinalDate OrdinalDate
Iso' Day OrdinalDate
ordinalDate
    random :: forall g. RandomGen g => g -> (OrdinalDate, g)
random = (Day -> OrdinalDate) -> (Day, g) -> (OrdinalDate, g)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Day -> Getting OrdinalDate Day OrdinalDate -> OrdinalDate
forall s a. s -> Getting a s a -> a
^. Getting OrdinalDate Day OrdinalDate
Iso' Day OrdinalDate
ordinalDate) ((Day, g) -> (OrdinalDate, g))
-> (g -> (Day, g)) -> g -> (OrdinalDate, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. g -> (Day, g)
forall g. RandomGen g => g -> (Day, g)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random

instance Arbitrary OrdinalDate where
    arbitrary :: Gen OrdinalDate
arbitrary = Getting OrdinalDate Day OrdinalDate -> Day -> OrdinalDate
forall a s. Getting a s a -> s -> a
view Getting OrdinalDate Day OrdinalDate
Iso' Day OrdinalDate
ordinalDate (Day -> OrdinalDate) -> Gen Day -> Gen OrdinalDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Day
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: OrdinalDate -> [OrdinalDate]
shrink OrdinalDate
od = Getting OrdinalDate Day OrdinalDate -> Day -> OrdinalDate
forall a s. Getting a s a -> s -> a
view Getting OrdinalDate Day OrdinalDate
Iso' Day OrdinalDate
ordinalDate (Day -> OrdinalDate) -> [Day] -> [OrdinalDate]
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 OrdinalDate OrdinalDate
Iso' Day OrdinalDate
ordinalDate Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
-> OrdinalDate -> Day
forall s t a b. AReview s t a b -> b -> t
# OrdinalDate
od)

instance CoArbitrary OrdinalDate where
    coarbitrary :: forall b. OrdinalDate -> Gen b -> Gen b
coarbitrary (OrdinalDate DayOfYear
y DayOfYear
d) = DayOfYear -> Gen b -> Gen b
forall b. DayOfYear -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary DayOfYear
y (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfYear -> Gen b -> Gen b
forall b. DayOfYear -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary DayOfYear
d

-- | Convert an 'OrdinalDate' to a 'Day', or 'Nothing' for invalid input.
--
-- @
-- > 'ordinalDateValid' ('OrdinalDate' 2015 365)
-- 'Just' 2015-12-31
--
-- > 'ordinalDateValid' ('OrdinalDate' 2015 366)
-- 'Nothing'
--
-- > 'ordinalDateValid' ('OrdinalDate' 2016 366)
-- 'Just' 2016-12-31
-- @
{-# INLINE ordinalDateValid #-}
ordinalDateValid :: OrdinalDate -> Maybe Day
ordinalDateValid :: OrdinalDate -> Maybe Day
ordinalDateValid od :: OrdinalDate
od@(OrdinalDate DayOfYear
y DayOfYear
d) = Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
Iso' Day OrdinalDate
ordinalDate Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
-> OrdinalDate -> Day
forall s t a b. AReview s t a b -> b -> t
# OrdinalDate
od
    Day -> Maybe () -> Maybe Day
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (DayOfYear
1 DayOfYear -> DayOfYear -> Bool
forall a. Ord a => a -> a -> Bool
<= DayOfYear
d Bool -> Bool -> Bool
&& DayOfYear
d DayOfYear -> DayOfYear -> Bool
forall a. Ord a => a -> a -> Bool
<= if DayOfYear -> Bool
isLeapYear DayOfYear
y then DayOfYear
366 else DayOfYear
365)

-- * Compatibility

{-# INLINE toOrdinalDate #-}
-- | Convert a 'Day' to its Gregorian 'Year' and 'DayOfYear'.
--
-- @
-- 'toOrdinalDate' ('view' 'ordinalDate' -> 'OrdinalDate' y d) = (y, d)
-- @
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate :: Day -> (DayOfYear, DayOfYear)
toOrdinalDate (Getting OrdinalDate Day OrdinalDate -> Day -> OrdinalDate
forall a s. Getting a s a -> s -> a
view Getting OrdinalDate Day OrdinalDate
Iso' Day OrdinalDate
ordinalDate -> OrdinalDate DayOfYear
y DayOfYear
d) = (DayOfYear
y, DayOfYear
d)

-- | Convert a Gregorian 'Year' and 'DayOfYear' to a 'Day'.
-- Does not validate the input.
--
-- @
-- 'fromOrdinalDate' y d = 'ordinalDate' 'Control.Lens.#' 'OrdinalDate' y d
-- @
{-# INLINE fromOrdinalDate #-}
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate :: DayOfYear -> DayOfYear -> Day
fromOrdinalDate DayOfYear
y DayOfYear
d = Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
Iso' Day OrdinalDate
ordinalDate Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
-> OrdinalDate -> Day
forall s t a b. AReview s t a b -> b -> t
# DayOfYear -> DayOfYear -> OrdinalDate
OrdinalDate DayOfYear
y DayOfYear
d

-- | Converts a Gregorian 'Year' and 'DayOfYear' to a 'Day'.
-- Returns 'Nothing' on invalid input.
--
-- @
-- 'fromOrdinalDateValid' y d = 'ordinalDateValid' ('OrdinalDate' y d)
-- @
{-# INLINE fromOrdinalDateValid #-}
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid :: DayOfYear -> DayOfYear -> Maybe Day
fromOrdinalDateValid DayOfYear
y DayOfYear
d = OrdinalDate -> Maybe Day
ordinalDateValid (DayOfYear -> DayOfYear -> OrdinalDate
OrdinalDate DayOfYear
y DayOfYear
d)

-- | Converts a 'Day' to its /Sunday/-starting week date.
--
-- The first /Sunday/ of the year belongs to @1 ∷ 'WeekOfYear'@; earlier
-- days in the same year are week @0@. This corresponds to @\"%U\"@ for
-- 'formatTime'.
--
-- /Sunday/ is @0 ∷ 'DayOfWeek'@, /Saturday/ is @6@. This corresponds to
-- @\"%w\"@ for 'formatTime'.
--
-- @
-- 'sundayStartWeek' ('view' 'sundayWeek' -> 'SundayWeek' y w d) = (y, w, d)
-- @
{-# INLINE sundayStartWeek #-}
sundayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)
sundayStartWeek :: Day -> (DayOfYear, DayOfYear, DayOfYear)
sundayStartWeek (Getting SundayWeek Day SundayWeek -> Day -> SundayWeek
forall a s. Getting a s a -> s -> a
view Getting SundayWeek Day SundayWeek
Iso' Day SundayWeek
sundayWeek -> SundayWeek DayOfYear
y DayOfYear
w DayOfYear
d) = (DayOfYear
y, DayOfYear
w, DayOfYear
d)

-- | Converts a /Sunday/-starting week date to the corresponding 'Day'; the
-- inverse of 'sundayStartWeek'.
-- Does not validate the input.
--
-- @
-- 'fromSundayStartWeek' y w d = 'sundayWeek' 'Control.Lens.#' 'SundayWeek' y w d
-- @
{-# INLINE fromSundayStartWeek #-}
fromSundayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day
fromSundayStartWeek :: DayOfYear -> DayOfYear -> DayOfYear -> Day
fromSundayStartWeek DayOfYear
y DayOfYear
w DayOfYear
d = Overloaded Reviewed Identity Day Day SundayWeek SundayWeek
Iso' Day SundayWeek
sundayWeek Overloaded Reviewed Identity Day Day SundayWeek SundayWeek
-> SundayWeek -> Day
forall s t a b. AReview s t a b -> b -> t
# DayOfYear -> DayOfYear -> DayOfYear -> SundayWeek
SundayWeek DayOfYear
y DayOfYear
w DayOfYear
d

-- | Converts a /Sunday/-starting week date to the corresponding 'Day'; the
-- inverse of 'sundayStartWeek'.
-- Returns 'Nothing' for invalid input.
--
-- @
-- 'fromSundayStartWeekValid' y w d = 'sundayWeekValid' ('SundayWeek' y w d)
-- @
{-# INLINE fromSundayStartWeekValid #-}
fromSundayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromSundayStartWeekValid :: DayOfYear -> DayOfYear -> DayOfYear -> Maybe Day
fromSundayStartWeekValid DayOfYear
y DayOfYear
w DayOfYear
d = SundayWeek -> Maybe Day
sundayWeekValid (DayOfYear -> DayOfYear -> DayOfYear -> SundayWeek
SundayWeek DayOfYear
y DayOfYear
w DayOfYear
d)

-- | Converts a 'Day' to its /Monday/-starting week date.
--
-- The first /Monday/ of the year belongs to @1 ∷ 'WeekOfYear'@; earlier
-- days in the same year are week @0@. This corresponds to @\"%W\"@ for
-- 'formatTime'.
--
-- /Monday/ is @1 ∷ 'DayOfWeek'@, /Sunday/ is @7@. This corresponds to
-- @\"%u\"@ for 'formatTime'.
--
-- @
-- 'mondayStartWeek' ('view' 'mondayWeek' -> 'MondayWeek' y w d) = (y, w, d)
-- @
{-# INLINE mondayStartWeek #-}
mondayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)
mondayStartWeek :: Day -> (DayOfYear, DayOfYear, DayOfYear)
mondayStartWeek (Getting MondayWeek Day MondayWeek -> Day -> MondayWeek
forall a s. Getting a s a -> s -> a
view Getting MondayWeek Day MondayWeek
Iso' Day MondayWeek
mondayWeek -> MondayWeek DayOfYear
y DayOfYear
w DayOfYear
d) = (DayOfYear
y, DayOfYear
w, DayOfYear
d)

-- | Converts a /Monday/-starting week date to the corresponding 'Day'; the
-- inverse of 'mondayStartWeek'.
-- Does not validate the input.
--
-- @
-- 'fromMondayStartWeek' y w d = 'mondayWeek' 'Control.Lens.#' 'MondayWeek' y w d
-- @
{-# INLINE fromMondayStartWeek #-}
fromMondayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day
fromMondayStartWeek :: DayOfYear -> DayOfYear -> DayOfYear -> Day
fromMondayStartWeek DayOfYear
y DayOfYear
w DayOfYear
d = Overloaded Reviewed Identity Day Day MondayWeek MondayWeek
Iso' Day MondayWeek
mondayWeek Overloaded Reviewed Identity Day Day MondayWeek MondayWeek
-> MondayWeek -> Day
forall s t a b. AReview s t a b -> b -> t
# DayOfYear -> DayOfYear -> DayOfYear -> MondayWeek
MondayWeek DayOfYear
y DayOfYear
w DayOfYear
d

-- | Converts a /Monday/-starting week date to the corresponding 'Day'; the
-- inverse of 'mondayStartWeek'.
-- Returns 'Nothing' for invalid input.
--
-- @
-- 'fromMondayStartWeekValid' y w d = 'mondayWeekValid' ('MondayWeek' y w d)
-- @
{-# INLINE fromMondayStartWeekValid #-}
fromMondayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromMondayStartWeekValid :: DayOfYear -> DayOfYear -> DayOfYear -> Maybe Day
fromMondayStartWeekValid DayOfYear
y DayOfYear
w DayOfYear
d = MondayWeek -> Maybe Day
mondayWeekValid (DayOfYear -> DayOfYear -> DayOfYear -> MondayWeek
MondayWeek DayOfYear
y DayOfYear
w DayOfYear
d)