{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
#if __GLASGOW_HASKELL__ == 706
{-# OPTIONS_GHC -fsimpl-tick-factor=120 #-} -- 7.6.3 only, it seems; fixes #29
#endif
#include "thyme.h"

-- | Various Week Date formats
module Data.Thyme.Calendar.WeekDate
    ( Year, WeekOfYear, DayOfWeek
    -- * ISO 8601 Week Date
    , WeekDate (..), weekDate, weekDateValid, showWeekDate
    -- * Weeks starting Sunday
    , SundayWeek (..), sundayWeek, sundayWeekValid
    -- * Weeks starting Monday
    , MondayWeek (..), mondayWeek, mondayWeekValid
    , module Data.Thyme.Calendar.WeekDate
    ) where

import Prelude
import Control.Applicative
import Control.Arrow
import Control.Lens
import Data.Thyme.Calendar.OrdinalDate
import Data.Thyme.Calendar.Internal
import System.Random
import Test.QuickCheck

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

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

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

instance Random WeekDate where
    randomR :: (WeekDate, WeekDate) -> g -> (WeekDate, g)
randomR = Iso' Day WeekDate -> (WeekDate, WeekDate) -> g -> (WeekDate, g)
forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Iso' Day WeekDate
weekDate
    random :: g -> (WeekDate, g)
random = (Day -> WeekDate) -> (Day, g) -> (WeekDate, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Day -> Getting WeekDate Day WeekDate -> WeekDate
forall s a. s -> Getting a s a -> a
^. Getting WeekDate Day WeekDate
Iso' Day WeekDate
weekDate) ((Day, g) -> (WeekDate, g))
-> (g -> (Day, g)) -> g -> (WeekDate, 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 Random SundayWeek where
    randomR :: (SundayWeek, SundayWeek) -> g -> (SundayWeek, g)
randomR = Iso' Day SundayWeek
-> (SundayWeek, SundayWeek) -> g -> (SundayWeek, g)
forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Iso' Day SundayWeek
sundayWeek
    random :: g -> (SundayWeek, g)
random = (Day -> SundayWeek) -> (Day, g) -> (SundayWeek, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Day -> Getting SundayWeek Day SundayWeek -> SundayWeek
forall s a. s -> Getting a s a -> a
^. Getting SundayWeek Day SundayWeek
Iso' Day SundayWeek
sundayWeek) ((Day, g) -> (SundayWeek, g))
-> (g -> (Day, g)) -> g -> (SundayWeek, 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 Random MondayWeek where
    randomR :: (MondayWeek, MondayWeek) -> g -> (MondayWeek, g)
randomR = Iso' Day MondayWeek
-> (MondayWeek, MondayWeek) -> g -> (MondayWeek, g)
forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Iso' Day MondayWeek
mondayWeek
    random :: g -> (MondayWeek, g)
random = (Day -> MondayWeek) -> (Day, g) -> (MondayWeek, g)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Day -> Getting MondayWeek Day MondayWeek -> MondayWeek
forall s a. s -> Getting a s a -> a
^. Getting MondayWeek Day MondayWeek
Iso' Day MondayWeek
mondayWeek) ((Day, g) -> (MondayWeek, g))
-> (g -> (Day, g)) -> g -> (MondayWeek, 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 WeekDate where
    arbitrary :: Gen WeekDate
arbitrary = Getting WeekDate Day WeekDate -> Day -> WeekDate
forall a s. Getting a s a -> s -> a
view Getting WeekDate Day WeekDate
Iso' Day WeekDate
weekDate (Day -> WeekDate) -> Gen Day -> Gen WeekDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Day
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: WeekDate -> [WeekDate]
shrink wd :: WeekDate
wd = Getting WeekDate Day WeekDate -> Day -> WeekDate
forall a s. Getting a s a -> s -> a
view Getting WeekDate Day WeekDate
Iso' Day WeekDate
weekDate (Day -> WeekDate) -> [Day] -> [WeekDate]
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 WeekDate WeekDate
Iso' Day WeekDate
weekDate Overloaded Reviewed Identity Day Day WeekDate WeekDate
-> WeekDate -> Day
forall s t a b. AReview s t a b -> b -> t
# WeekDate
wd)

instance Arbitrary SundayWeek where
    arbitrary :: Gen SundayWeek
arbitrary = Getting SundayWeek Day SundayWeek -> Day -> SundayWeek
forall a s. Getting a s a -> s -> a
view Getting SundayWeek Day SundayWeek
Iso' Day SundayWeek
sundayWeek (Day -> SundayWeek) -> Gen Day -> Gen SundayWeek
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Day
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: SundayWeek -> [SundayWeek]
shrink sw :: SundayWeek
sw = Getting SundayWeek Day SundayWeek -> Day -> SundayWeek
forall a s. Getting a s a -> s -> a
view Getting SundayWeek Day SundayWeek
Iso' Day SundayWeek
sundayWeek (Day -> SundayWeek) -> [Day] -> [SundayWeek]
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 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
# SundayWeek
sw)

instance Arbitrary MondayWeek where
    arbitrary :: Gen MondayWeek
arbitrary = Getting MondayWeek Day MondayWeek -> Day -> MondayWeek
forall a s. Getting a s a -> s -> a
view Getting MondayWeek Day MondayWeek
Iso' Day MondayWeek
mondayWeek (Day -> MondayWeek) -> Gen Day -> Gen MondayWeek
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Day
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: MondayWeek -> [MondayWeek]
shrink mw :: MondayWeek
mw = Getting MondayWeek Day MondayWeek -> Day -> MondayWeek
forall a s. Getting a s a -> s -> a
view Getting MondayWeek Day MondayWeek
Iso' Day MondayWeek
mondayWeek (Day -> MondayWeek) -> [Day] -> [MondayWeek]
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 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
# MondayWeek
mw)

instance CoArbitrary WeekDate where
    coarbitrary :: WeekDate -> Gen b -> Gen b
coarbitrary (WeekDate y :: Year
y w :: Year
w 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
w (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

instance CoArbitrary SundayWeek where
    coarbitrary :: SundayWeek -> Gen b -> Gen b
coarbitrary (SundayWeek y :: Year
y w :: Year
w 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
w (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

instance CoArbitrary MondayWeek where
    coarbitrary :: MondayWeek -> Gen b -> Gen b
coarbitrary (MondayWeek y :: Year
y w :: Year
w 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
w (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

-- * Lenses

LENS(WeekDate,wdYear,Year)
LENS(WeekDate,wdWeek,WeekOfYear)
LENS(WeekDate,wdDay,DayOfWeek)

LENS(SundayWeek,swYear,Year)
LENS(SundayWeek,swWeek,WeekOfYear)
LENS(SundayWeek,swDay,DayOfWeek)

LENS(MondayWeek,mwYear,Year)
LENS(MondayWeek,mwWeek,WeekOfYear)
LENS(MondayWeek,mwDay,DayOfWeek)