{-# LANGUAGE Safe #-}

module Data.Time.Calendar.Days (
    -- * Days
    Day (..),
    addDays,
    diffDays,

    -- * DayPeriod
    DayPeriod (..),
    periodAllDays,
    periodLength,
    periodFromDay,
    periodToDay,
    periodToDayValid,
) where

import Control.DeepSeq
import Data.Data
import Data.Ix

-- | The Modified Julian Day is a standard count of days, with zero being the day 1858-11-17.
newtype Day = ModifiedJulianDay
    { Day -> Integer
toModifiedJulianDay :: Integer
    }
    deriving (Day -> Day -> Bool
(Day -> Day -> Bool) -> (Day -> Day -> Bool) -> Eq Day
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Day -> Day -> Bool
$c/= :: Day -> Day -> Bool
== :: Day -> Day -> Bool
$c== :: Day -> Day -> Bool
Eq, Eq Day
Eq Day
-> (Day -> Day -> Ordering)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Bool)
-> (Day -> Day -> Day)
-> (Day -> Day -> Day)
-> Ord Day
Day -> Day -> Bool
Day -> Day -> Ordering
Day -> Day -> Day
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Day -> Day -> Day
$cmin :: Day -> Day -> Day
max :: Day -> Day -> Day
$cmax :: Day -> Day -> Day
>= :: Day -> Day -> Bool
$c>= :: Day -> Day -> Bool
> :: Day -> Day -> Bool
$c> :: Day -> Day -> Bool
<= :: Day -> Day -> Bool
$c<= :: Day -> Day -> Bool
< :: Day -> Day -> Bool
$c< :: Day -> Day -> Bool
compare :: Day -> Day -> Ordering
$ccompare :: Day -> Day -> Ordering
$cp1Ord :: Eq Day
Ord, Typeable Day
DataType
Constr
Typeable Day
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Day -> c Day)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Day)
-> (Day -> Constr)
-> (Day -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Day))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day))
-> ((forall b. Data b => b -> b) -> Day -> Day)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r)
-> (forall u. (forall d. Data d => d -> u) -> Day -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Day -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Day -> m Day)
-> Data Day
Day -> DataType
Day -> Constr
(forall b. Data b => b -> b) -> Day -> Day
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Day -> u
forall u. (forall d. Data d => d -> u) -> Day -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Day -> m Day
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Day)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
$cModifiedJulianDay :: Constr
$tDay :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapMp :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapM :: (forall d. Data d => d -> m d) -> Day -> m Day
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Day -> m Day
gmapQi :: Int -> (forall d. Data d => d -> u) -> Day -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Day -> u
gmapQ :: (forall d. Data d => d -> u) -> Day -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Day -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Day -> r
gmapT :: (forall b. Data b => b -> b) -> Day -> Day
$cgmapT :: (forall b. Data b => b -> b) -> Day -> Day
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Day)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Day)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Day)
dataTypeOf :: Day -> DataType
$cdataTypeOf :: Day -> DataType
toConstr :: Day -> Constr
$ctoConstr :: Day -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Day
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Day -> c Day
$cp1Data :: Typeable Day
Data, Typeable)

instance NFData Day where
    rnf :: Day -> ()
rnf (ModifiedJulianDay Integer
a) = Integer -> ()
forall a. NFData a => a -> ()
rnf Integer
a

instance Enum Day where
    succ :: Day -> Day
succ (ModifiedJulianDay Integer
a) = Integer -> Day
ModifiedJulianDay (Integer -> Integer
forall a. Enum a => a -> a
succ Integer
a)
    pred :: Day -> Day
pred (ModifiedJulianDay Integer
a) = Integer -> Day
ModifiedJulianDay (Integer -> Integer
forall a. Enum a => a -> a
pred Integer
a)
    toEnum :: Int -> Day
toEnum = Integer -> Day
ModifiedJulianDay (Integer -> Day) -> (Int -> Integer) -> Int -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Enum a => Int -> a
toEnum
    fromEnum :: Day -> Int
fromEnum (ModifiedJulianDay Integer
a) = Integer -> Int
forall a. Enum a => a -> Int
fromEnum Integer
a
    enumFrom :: Day -> [Day]
enumFrom (ModifiedJulianDay Integer
a) = (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
ModifiedJulianDay (Integer -> [Integer]
forall a. Enum a => a -> [a]
enumFrom Integer
a)
    enumFromThen :: Day -> Day -> [Day]
enumFromThen (ModifiedJulianDay Integer
a) (ModifiedJulianDay Integer
b) = (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
ModifiedJulianDay (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromThen Integer
a Integer
b)
    enumFromTo :: Day -> Day -> [Day]
enumFromTo (ModifiedJulianDay Integer
a) (ModifiedJulianDay Integer
b) = (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
ModifiedJulianDay (Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> [a]
enumFromTo Integer
a Integer
b)
    enumFromThenTo :: Day -> Day -> Day -> [Day]
enumFromThenTo (ModifiedJulianDay Integer
a) (ModifiedJulianDay Integer
b) (ModifiedJulianDay Integer
c) =
        (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
ModifiedJulianDay (Integer -> Integer -> Integer -> [Integer]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo Integer
a Integer
b Integer
c)

instance Ix Day where
    range :: (Day, Day) -> [Day]
range (ModifiedJulianDay Integer
a, ModifiedJulianDay Integer
b) = (Integer -> Day) -> [Integer] -> [Day]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Day
ModifiedJulianDay ((Integer, Integer) -> [Integer]
forall a. Ix a => (a, a) -> [a]
range (Integer
a, Integer
b))
    index :: (Day, Day) -> Day -> Int
index (ModifiedJulianDay Integer
a, ModifiedJulianDay Integer
b) (ModifiedJulianDay Integer
c) = (Integer, Integer) -> Integer -> Int
forall a. Ix a => (a, a) -> a -> Int
index (Integer
a, Integer
b) Integer
c
    inRange :: (Day, Day) -> Day -> Bool
inRange (ModifiedJulianDay Integer
a, ModifiedJulianDay Integer
b) (ModifiedJulianDay Integer
c) = (Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer
a, Integer
b) Integer
c
    rangeSize :: (Day, Day) -> Int
rangeSize (ModifiedJulianDay Integer
a, ModifiedJulianDay Integer
b) = (Integer, Integer) -> Int
forall a. Ix a => (a, a) -> Int
rangeSize (Integer
a, Integer
b)

addDays :: Integer -> Day -> Day
addDays :: Integer -> Day -> Day
addDays Integer
n (ModifiedJulianDay Integer
a) = Integer -> Day
ModifiedJulianDay (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
n)

diffDays :: Day -> Day -> Integer
diffDays :: Day -> Day -> Integer
diffDays (ModifiedJulianDay Integer
a) (ModifiedJulianDay Integer
b) = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
b

-- | The class of types which can be represented as a period of days.
--
-- @since 1.12.1
class Ord p => DayPeriod p where
    -- | Returns the first 'Day' in a period of days.
    periodFirstDay :: p -> Day

    -- | Returns the last 'Day' in a period of days.
    periodLastDay :: p -> Day

    -- | Get the period this day is in.
    dayPeriod :: Day -> p

-- | A list of all the days in this period.
--
-- @since 1.12.1
periodAllDays :: DayPeriod p => p -> [Day]
periodAllDays :: p -> [Day]
periodAllDays p
p = [p -> Day
forall p. DayPeriod p => p -> Day
periodFirstDay p
p .. p -> Day
forall p. DayPeriod p => p -> Day
periodLastDay p
p]

-- | The number of days in this period.
--
-- @since 1.12.1
periodLength :: DayPeriod p => p -> Int
periodLength :: p -> Int
periodLength p
p = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays (p -> Day
forall p. DayPeriod p => p -> Day
periodLastDay p
p) (p -> Day
forall p. DayPeriod p => p -> Day
periodFirstDay p
p)

-- | Get the period this day is in, with the 1-based day number within the period.
--
-- @periodFromDay (periodFirstDay p) = (p,1)@
--
-- @since 1.12.1
periodFromDay :: DayPeriod p => Day -> (p, Int)
periodFromDay :: Day -> (p, Int)
periodFromDay Day
d = let
    p :: p
p = Day -> p
forall p. DayPeriod p => Day -> p
dayPeriod Day
d
    dt :: Int
dt = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
d (Day -> Integer) -> Day -> Integer
forall a b. (a -> b) -> a -> b
$ p -> Day
forall p. DayPeriod p => p -> Day
periodFirstDay p
p
    in (p
p, Int
dt)

-- | Inverse of 'periodFromDay'.
--
-- @since 1.12.1
periodToDay :: DayPeriod p => p -> Int -> Day
periodToDay :: p -> Int -> Day
periodToDay p
p Int
i = Integer -> Day -> Day
addDays (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
i) (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ p -> Day
forall p. DayPeriod p => p -> Day
periodFirstDay p
p

-- | Validating inverse of 'periodFromDay'.
--
-- @since 1.12.1
periodToDayValid :: DayPeriod p => p -> Int -> Maybe Day
periodToDayValid :: p -> Int -> Maybe Day
periodToDayValid p
p Int
i = let
    d :: Day
d = p -> Int -> Day
forall p. DayPeriod p => p -> Int -> Day
periodToDay p
p Int
i
    in if (p, Int) -> p
forall a b. (a, b) -> a
fst (Day -> (p, Int)
forall p. DayPeriod p => Day -> (p, Int)
periodFromDay Day
d) p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
p then Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d else Maybe Day
forall a. Maybe a
Nothing

instance DayPeriod Day where
    periodFirstDay :: Day -> Day
periodFirstDay = Day -> Day
forall a. a -> a
id
    periodLastDay :: Day -> Day
periodLastDay = Day -> Day
forall a. a -> a
id
    dayPeriod :: Day -> Day
dayPeriod = Day -> Day
forall a. a -> a
id