-- | This module provides data definitions and functions for date values.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Haspara.Internal.Date where

import qualified Data.Aeson     as Aeson
import           Data.Bifunctor (first)
import           Data.Hashable  (Hashable(..))
import qualified Data.Text      as T
import qualified Data.Time      as DT


-- * Data Definition
-- &dataDefinition


-- | Type encoding for date values.
--
-- This is a convenience wrapper around 'Day' type. It helps us to avoid
-- defining orphan instances.
newtype Date = MkDate DT.Day deriving (Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq, Int -> Date
Date -> Int
Date -> [Date]
Date -> Date
Date -> Date -> [Date]
Date -> Date -> Date -> [Date]
(Date -> Date)
-> (Date -> Date)
-> (Int -> Date)
-> (Date -> Int)
-> (Date -> [Date])
-> (Date -> Date -> [Date])
-> (Date -> Date -> [Date])
-> (Date -> Date -> Date -> [Date])
-> Enum Date
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Date -> Date -> Date -> [Date]
$cenumFromThenTo :: Date -> Date -> Date -> [Date]
enumFromTo :: Date -> Date -> [Date]
$cenumFromTo :: Date -> Date -> [Date]
enumFromThen :: Date -> Date -> [Date]
$cenumFromThen :: Date -> Date -> [Date]
enumFrom :: Date -> [Date]
$cenumFrom :: Date -> [Date]
fromEnum :: Date -> Int
$cfromEnum :: Date -> Int
toEnum :: Int -> Date
$ctoEnum :: Int -> Date
pred :: Date -> Date
$cpred :: Date -> Date
succ :: Date -> Date
$csucc :: Date -> Date
Enum, Eq Date
Eq Date
-> (Date -> Date -> Ordering)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Bool)
-> (Date -> Date -> Date)
-> (Date -> Date -> Date)
-> Ord Date
Date -> Date -> Bool
Date -> Date -> Ordering
Date -> Date -> Date
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 :: Date -> Date -> Date
$cmin :: Date -> Date -> Date
max :: Date -> Date -> Date
$cmax :: Date -> Date -> Date
>= :: Date -> Date -> Bool
$c>= :: Date -> Date -> Bool
> :: Date -> Date -> Bool
$c> :: Date -> Date -> Bool
<= :: Date -> Date -> Bool
$c<= :: Date -> Date -> Bool
< :: Date -> Date -> Bool
$c< :: Date -> Date -> Bool
compare :: Date -> Date -> Ordering
$ccompare :: Date -> Date -> Ordering
$cp1Ord :: Eq Date
Ord)


-- | 'Hashable' instance for 'Date'.
instance Hashable Date where
  hashWithSalt :: Int -> Date -> Int
hashWithSalt Int
salt (MkDate (DT.ModifiedJulianDay Integer
i)) = Int -> Integer -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Integer
i


-- | 'Read' instance for 'Date'.
--
-- >>> read "2021-01-01" :: Date
-- 2021-01-01
-- >>> read "Just 2021-01-01" :: Maybe Date
-- Just 2021-01-01
instance Read Date where
  readsPrec :: Int -> ReadS Date
readsPrec Int
_ = Bool -> ReadS Date -> ReadS Date
forall a. Bool -> ReadS a -> ReadS a
readParen Bool
False (ReadS Date -> ReadS Date) -> ReadS Date -> ReadS Date
forall a b. (a -> b) -> a -> b
$ ((Day, String) -> (Date, String))
-> [(Day, String)] -> [(Date, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Day -> Date) -> (Day, String) -> (Date, String)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Day -> Date
MkDate) ([(Day, String)] -> [(Date, String)])
-> (String -> [(Day, String)]) -> ReadS Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> TimeLocale -> String -> String -> [(Day, String)]
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
DT.readSTime Bool
True TimeLocale
DT.defaultTimeLocale String
"%Y-%m-%d"


-- | 'Show' instance for 'Date'.
--
-- >>> fromYMD 2020 12 31
-- 2020-12-31
instance Show Date where
  show :: Date -> String
show = Date -> String
toString


-- | 'Aeson.FromJSON' instance for 'Date'.
--
-- >>> Aeson.decode "\"2020-12-31\"" :: Maybe Date
-- Just 2020-12-31
instance Aeson.FromJSON Date where
  parseJSON :: Value -> Parser Date
parseJSON = String -> (Text -> Parser Date) -> Value -> Parser Date
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Date" Text -> Parser Date
forall (m :: * -> *). MonadFail m => Text -> m Date
fromText


-- | 'Aeson.ToJSON' instance for 'Date'.
--
-- >>> Aeson.encode (MkDate (read "2021-01-01"))
-- "\"2021-01-01\""
instance Aeson.ToJSON Date where
  toJSON :: Date -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Date -> Text) -> Date -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Date -> String) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> String
forall a. Show a => a -> String
show


-- * Constructors
-- &constructors


-- | Builds a 'Date' from a given 'Day'.
--
-- >>> fromDay (read "2021-01-01")
-- 2021-01-01
fromDay :: DT.Day -> Date
fromDay :: Day -> Date
fromDay = Day -> Date
MkDate


-- | Builds a 'Date' from a given year, month and day as in Gregorian calendar.
--
-- >>> fromYMD 2021 1 1
-- 2021-01-01
fromYMD :: Integer -> Int -> Int -> Date
fromYMD :: Integer -> Int -> Int -> Date
fromYMD Integer
y Int
m Int
d = Day -> Date
fromDay (Integer -> Int -> Int -> Day
DT.fromGregorian Integer
y Int
m Int
d)


-- | Attempts to parse and return 'Date' from a given 'String' with ISO format.
--
-- >>> fromString "2021-01-01" :: Maybe Date
-- Just 2021-01-01
-- >>> fromString "20210101" :: Maybe Date
-- Nothing
fromString :: MonadFail m => String -> m Date
fromString :: String -> m Date
fromString = String -> String -> m Date
forall (m :: * -> *). MonadFail m => String -> String -> m Date
fromFormattedString String
"%Y-%m-%d"


-- | Attempts to parse and return 'Date' from a given 'String' with given date format.
--
-- >>> fromFormattedString "%Y-%m-%d" "2021-01-01" :: Maybe Date
-- Just 2021-01-01
-- >>> fromFormattedString "%Y%m%d" "20210101" :: Maybe Date
-- Just 2021-01-01
-- >>> fromFormattedString "%Y%m%d" "202101" :: Maybe Date
-- Nothing
fromFormattedString :: MonadFail m => String -> String -> m Date
fromFormattedString :: String -> String -> m Date
fromFormattedString String
fmt = (Day -> Date) -> m Day -> m Date
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Day -> Date
fromDay (m Day -> m Date) -> (String -> m Day) -> String -> m Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> m Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
DT.parseTimeM Bool
False TimeLocale
DT.defaultTimeLocale String
fmt


-- | Attempts to parse and return 'Date' from a given 'T.Text' with ISO format.
--
-- >>> fromText "2021-01-01" :: Maybe Date
-- Just 2021-01-01
-- >>> fromText "20210101" :: Maybe Date
-- Nothing
fromText :: MonadFail m => T.Text -> m Date
fromText :: Text -> m Date
fromText = String -> m Date
forall (m :: * -> *). MonadFail m => String -> m Date
fromString (String -> m Date) -> (Text -> String) -> Text -> m Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack


-- | Attempts to parse and return 'Date' from a given 'T.Text' with ISO format.
--
-- >>> fromFormattedText "%Y-%m-%d" "2021-01-01" :: Maybe Date
-- Just 2021-01-01
-- >>> fromFormattedText "%Y%m%d" "20210101" :: Maybe Date
-- Just 2021-01-01
-- >>> fromFormattedText "%Y%m%d" "202101" :: Maybe Date
-- Nothing
fromFormattedText :: MonadFail m => String -> T.Text -> m Date
fromFormattedText :: String -> Text -> m Date
fromFormattedText String
fmt = String -> String -> m Date
forall (m :: * -> *). MonadFail m => String -> String -> m Date
fromFormattedString String
fmt  (String -> m Date) -> (Text -> String) -> Text -> m Date
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack


-- * Conversions
-- &conversions


-- | Converts 'Date' value to a 'DT.Day' value.
--
-- >>> toDay (read "2021-01-01")
-- 2021-01-01
toDay :: Date -> DT.Day
toDay :: Date -> Day
toDay (MkDate Day
d) = Day
d


-- | Converts 'Date' value to a 3-tuple of year, month and day.
--
-- >>> toYMD (read "2020-12-31")
-- (2020,12,31)
toYMD :: Date -> (Integer, Int, Int)
toYMD :: Date -> (Integer, Int, Int)
toYMD = Day -> (Integer, Int, Int)
DT.toGregorian (Day -> (Integer, Int, Int))
-> (Date -> Day) -> Date -> (Integer, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Day
toDay


-- | Converts 'Date' value into a 'String' value with ISO format.
--
-- >>> toString (read "2021-01-01")
-- "2021-01-01"
toString :: Date -> String
toString :: Date -> String
toString = String -> Date -> String
toFormattedString String
"%Y-%m-%d"


-- | Converts 'Date' value into a 'String' value with the given format.
--
-- >>> toFormattedString "%Y-%m-%d" (read "2021-01-01")
-- "2021-01-01"
-- >>> toFormattedString "%d/%m/%Y" (read "2021-01-01")
-- "01/01/2021"
toFormattedString :: String -> Date -> String
toFormattedString :: String -> Date -> String
toFormattedString String
fmt = TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
DT.formatTime TimeLocale
DT.defaultTimeLocale String
fmt (Day -> String) -> (Date -> Day) -> Date -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> Day
toDay


-- | Converts 'Date' value into a 'T.Text' value with ISO format.
--
-- >>> toText (read "2021-01-01")
-- "2021-01-01"
toText :: Date -> T.Text
toText :: Date -> Text
toText = String -> Text
T.pack (String -> Text) -> (Date -> String) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> String
toString


-- | Converts 'Date' value into a 'T.Text' value with the given format.
--
-- >>> toFormattedText "%Y-%m-%d" (read "2021-01-01")
-- "2021-01-01"
-- >>> toFormattedText "%d/%m/%Y" (read "2021-01-01")
-- "01/01/2021"
toFormattedText :: String -> Date -> T.Text
toFormattedText :: String -> Date -> Text
toFormattedText String
fmt = String -> Text
T.pack (String -> Text) -> (Date -> String) -> Date -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Date -> String
toFormattedString String
fmt


-- * Helper Functions
-- &helpers


-- | Adds (or subtracts) some days.
--
-- >>> addDays (-1) $ fromYMD 2021 1 1
-- 2020-12-31
-- >>> addDays 1 $ addDays (-1) $ fromYMD 2021 1 1
-- 2021-01-01
addDays :: Integer -> Date -> Date
addDays :: Integer -> Date -> Date
addDays Integer
x (MkDate Day
d) = Day -> Date
MkDate (Integer -> Day -> Day
DT.addDays Integer
x Day
d)