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

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

import Prelude
import Control.Applicative
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 :: (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 Iso' Day OrdinalDate
ordinalDate
    random :: g -> (OrdinalDate, g)
random = (Day -> OrdinalDate) -> (Day, g) -> (OrdinalDate, g)
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 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 od :: 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 :: OrdinalDate -> Gen b -> Gen b
coarbitrary (OrdinalDate y :: Year
y d :: Year
d) = Year -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Year
y (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Year -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Year
d

{-# INLINE ordinalDateValid #-}
ordinalDateValid :: OrdinalDate -> Maybe Day
ordinalDateValid :: OrdinalDate -> Maybe Day
ordinalDateValid od :: OrdinalDate
od@(OrdinalDate y :: Year
y d :: Year
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 (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (1 Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
<= Year
d Bool -> Bool -> Bool
&& Year
d Year -> Year -> Bool
forall a. Ord a => a -> a -> Bool
<= if Year -> Bool
isLeapYear Year
y then 366 else 365)

-- * Lenses
LENS(OrdinalDate,odYear,Year)
LENS(OrdinalDate,odDay,DayOfYear)