{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

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

-- | Calendar date reckoned by year, month-of-year, and n-th day-of-week.
module Data.Thyme.Calendar.WeekdayOfMonth
    ( Year, Month, DayOfWeek
    , module Data.Thyme.Calendar.WeekdayOfMonth
    ) where

import Prelude
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Arrow
import Control.DeepSeq
import Control.Lens
import Control.Monad
import Data.AffineSpace
import Data.Bits
import Data.Data
import Data.Hashable
import Data.Thyme.Calendar
import Data.Thyme.Calendar.Internal
#if __GLASGOW_HASKELL__ == 704
import qualified Data.Vector.Generic
import qualified Data.Vector.Generic.Mutable
#endif
import Data.Vector.Unboxed.Deriving
import GHC.Generics (Generic)
import System.Random
import Test.QuickCheck hiding ((.&.))

-- | Calendar date with year, month-of-year, and n-th day-of-week.
data WeekdayOfMonth = WeekdayOfMonth
    { WeekdayOfMonth -> Int
womYear :: {-# UNPACK #-}!Year
        -- ^ Calendar year.
    , WeekdayOfMonth -> Int
womMonth :: {-# UNPACK #-}!Month
        -- ^ Month of year.
    , WeekdayOfMonth -> Int
womNth :: {-# UNPACK #-}!Int
        -- ^ /N/-th 'DayOfWeek'. Range /±1–5/; negative means the /N/-th
        -- last 'DayOfWeek' of the month.
    , WeekdayOfMonth -> Int
womDayOfWeek :: {-# UNPACK #-}!DayOfWeek
        -- ^ Day of week. /1 = Monday, 7 = Sunday/, like ISO 8601 'WeekDate'.
    } deriving (INSTANCES_USUAL, Show)

LENS(WeekdayOfMonth,womYear,Year)
LENS(WeekdayOfMonth,womMonth,Month)
LENS(WeekdayOfMonth,womNth,Int)
LENS(WeekdayOfMonth,womDayOfWeek,DayOfWeek)

derivingUnbox "WeekdayOfMonth"
    [t| WeekdayOfMonth -> Int |]
    [| \ WeekdayOfMonth {..} -> shiftL womYear 11 .|. shiftL womMonth 7
        .|. shiftL (womNth + 5) 3 .|. womDayOfWeek |]
    [| \ n -> WeekdayOfMonth (shiftR n 11) (shiftR n 7 .&. 0xf)
        (shiftR n 3 - 5) (n .&. 0x7) |]

instance Hashable WeekdayOfMonth
instance NFData WeekdayOfMonth

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

instance Random WeekdayOfMonth where
    randomR :: forall g.
RandomGen g =>
(WeekdayOfMonth, WeekdayOfMonth) -> g -> (WeekdayOfMonth, g)
randomR = Iso' Day WeekdayOfMonth
-> (WeekdayOfMonth, WeekdayOfMonth) -> g -> (WeekdayOfMonth, g)
forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Overloaded p f Day Day WeekdayOfMonth WeekdayOfMonth
Iso' Day WeekdayOfMonth
weekdayOfMonth
    random :: forall g. RandomGen g => g -> (WeekdayOfMonth, g)
random = (Day -> WeekdayOfMonth) -> (Day, g) -> (WeekdayOfMonth, 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 WeekdayOfMonth Day WeekdayOfMonth -> WeekdayOfMonth
forall s a. s -> Getting a s a -> a
^. Getting WeekdayOfMonth Day WeekdayOfMonth
Iso' Day WeekdayOfMonth
weekdayOfMonth) ((Day, g) -> (WeekdayOfMonth, g))
-> (g -> (Day, g)) -> g -> (WeekdayOfMonth, 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 WeekdayOfMonth where
    arbitrary :: Gen WeekdayOfMonth
arbitrary = Getting WeekdayOfMonth Day WeekdayOfMonth -> Day -> WeekdayOfMonth
forall a s. Getting a s a -> s -> a
view Getting WeekdayOfMonth Day WeekdayOfMonth
Iso' Day WeekdayOfMonth
weekdayOfMonth (Day -> WeekdayOfMonth) -> Gen Day -> Gen WeekdayOfMonth
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Day
forall a. Arbitrary a => Gen a
arbitrary
    shrink :: WeekdayOfMonth -> [WeekdayOfMonth]
shrink WeekdayOfMonth
wom = Getting WeekdayOfMonth Day WeekdayOfMonth -> Day -> WeekdayOfMonth
forall a s. Getting a s a -> s -> a
view Getting WeekdayOfMonth Day WeekdayOfMonth
Iso' Day WeekdayOfMonth
weekdayOfMonth (Day -> WeekdayOfMonth) -> [Day] -> [WeekdayOfMonth]
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 WeekdayOfMonth WeekdayOfMonth
Iso' Day WeekdayOfMonth
weekdayOfMonth Overloaded Reviewed Identity Day Day WeekdayOfMonth WeekdayOfMonth
-> WeekdayOfMonth -> Day
forall s t a b. AReview s t a b -> b -> t
# WeekdayOfMonth
wom)

instance CoArbitrary WeekdayOfMonth where
    coarbitrary :: forall b. WeekdayOfMonth -> Gen b -> Gen b
coarbitrary (WeekdayOfMonth Int
y Int
m Int
n Int
d)
        = Int -> Gen b -> Gen b
forall b. 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen b -> Gen b
forall b. 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen b -> Gen b
forall b. Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Int
n (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Gen b -> Gen b
forall b. Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Int
d

-- | Conversion between a 'Day' and and 'WeekdayOfMonth'.
--
-- This is a proper 'Iso' if and only if all of the 'WeekdayOfMonth' fields
-- are valid and positive.
--
-- For example, the last /Monday/ in /January 2016/ is also the fourth
-- /Monday/:
--
-- @
-- > 'weekdayOfMonth' 'Control.Lens.#' 'WeekdayOfMonth' 2016 1 (-1) 1
-- 2016-01-25
-- > 'YearMonthDay' 2016 01 25 '^.' 'from' 'gregorian' '.' 'weekdayOfMonth'
-- 'WeekdayOfMonth' {'womYear' = 2016, 'womMonth' = 1, 'womNth' = 4, 'womDayOfWeek' = 1}
-- @
{-# INLINE weekdayOfMonth #-}
weekdayOfMonth :: Iso' Day WeekdayOfMonth
weekdayOfMonth :: Iso' Day WeekdayOfMonth
weekdayOfMonth = (Day -> WeekdayOfMonth)
-> (WeekdayOfMonth -> Day) -> Iso' Day WeekdayOfMonth
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Day -> WeekdayOfMonth
toWeekday WeekdayOfMonth -> Day
fromWeekday where

    {-# INLINEABLE toWeekday #-}
    toWeekday :: Day -> WeekdayOfMonth
    toWeekday :: Day -> WeekdayOfMonth
toWeekday day :: Day
day@(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
ord) = Int -> Int -> Int -> Int -> WeekdayOfMonth
WeekdayOfMonth Int
y Int
m Int
n Int
wd where
        YearMonthDay Int
y Int
m Int
d = OrdinalDate
ord OrdinalDate
-> Getting YearMonthDay OrdinalDate YearMonthDay -> YearMonthDay
forall s a. s -> Getting a s a -> a
^. Getting YearMonthDay OrdinalDate YearMonthDay
Iso' OrdinalDate YearMonthDay
yearMonthDay
        WeekDate Int
_ Int
_ Int
wd = OrdinalDate -> Day -> WeekDate
toWeekOrdinal OrdinalDate
ord Day
day
        n :: Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
7

    {-# INLINEABLE fromWeekday #-}
    fromWeekday :: WeekdayOfMonth -> Day
    fromWeekday :: WeekdayOfMonth -> Day
fromWeekday (WeekdayOfMonth Int
y Int
m Int
n Int
wd) = Day
refDay Day -> Diff Day -> Day
forall p. AffineSpace p => p -> Diff p -> p
.+^ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
offset where
        refOrd :: OrdinalDate
refOrd = Overloaded
  Reviewed Identity OrdinalDate OrdinalDate YearMonthDay YearMonthDay
Iso' OrdinalDate YearMonthDay
yearMonthDay Overloaded
  Reviewed Identity OrdinalDate OrdinalDate YearMonthDay YearMonthDay
-> YearMonthDay -> OrdinalDate
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> Int -> YearMonthDay
YearMonthDay Int
y Int
m
            (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Bool -> Int -> Int
monthLength (Int -> Bool
isLeapYear Int
y) Int
m else Int
1)
        refDay :: Day
refDay = 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
refOrd
        WeekDate Int
_ Int
_ Int
wd1 = OrdinalDate -> Day -> WeekDate
toWeekOrdinal OrdinalDate
refOrd Day
refDay
        s :: Int
s = Int -> Int
forall a. Num a => a -> a
signum Int
n
        wo :: Int
wo = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
wd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wd1)
        offset :: Int
offset = (Int -> Int
forall a. Num a => a -> a
abs Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
wo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
wo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 else Int
wo

-- | Convert a 'WeekdayOfMonth' to a 'Day'.
-- Returns 'Nothing' for invalid input.
--
-- For example, the third /Sunday/ of /January 2016/ is /2016-01-27/, but
-- there is no fifth /Monday/ in /January 2016/.
--
-- @
-- > 'weekdayOfMonthValid' ('WeekdayOfMonth' 2016 1 3 7)
-- 'Just' 2016-01-17
-- > 'weekdayOfMonthValid' ('WeekdayOfMonth' 2016 1 5 1)
-- 'Nothing'
-- @
{-# INLINEABLE weekdayOfMonthValid #-}
weekdayOfMonthValid :: WeekdayOfMonth -> Maybe Day
weekdayOfMonthValid :: WeekdayOfMonth -> Maybe Day
weekdayOfMonthValid (WeekdayOfMonth Int
y Int
m Int
n Int
wd) = (Day
refDay Day -> Diff Day -> Day
forall p. AffineSpace p => p -> Diff p -> p
.+^ Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
offset)
        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 (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 Bool -> Bool -> Bool
&& Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
wd Bool -> Bool -> Bool
&& Int
wd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 Bool -> Bool -> Bool
&& Int
offset Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) where
    len :: Int
len = Bool -> Int -> Int
monthLength (Int -> Bool
isLeapYear Int
y) Int
m
    refOrd :: OrdinalDate
refOrd = Overloaded
  Reviewed Identity OrdinalDate OrdinalDate YearMonthDay YearMonthDay
Iso' OrdinalDate YearMonthDay
yearMonthDay Overloaded
  Reviewed Identity OrdinalDate OrdinalDate YearMonthDay YearMonthDay
-> YearMonthDay -> OrdinalDate
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> Int -> YearMonthDay
YearMonthDay Int
y Int
m (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
len else Int
1)
    refDay :: Day
refDay = 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
refOrd
    WeekDate Int
_ Int
_ Int
wd1 = OrdinalDate -> Day -> WeekDate
toWeekOrdinal OrdinalDate
refOrd Day
refDay
    s :: Int
s = Int -> Int
forall a. Num a => a -> a
signum Int
n
    wo :: Int
wo = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
wd Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
wd1)
    offset :: Int
offset = (Int -> Int
forall a. Num a => a -> a
abs Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if Int
wo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
wo Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 else Int
wo