{-# LANGUAGE CPP                #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE Trustworthy        #-}
-- | 'Month' data type.
module Data.Time.MonthName (
    -- * Types
    MonthName (..),
    -- * Conversion with Day
    dayToYearMonthName,
    firstDayOfYearMonthName,
    lastDayOfYearMonthName,
#ifdef MIN_VERSION_intervals
    yearMonthNameInterval,
#endif
    -- * Conversions with Text
    monthNameToText,
    parseMonthName,
    yearMonthNameToText,
    parseYearMonthName,
) where

import Control.Applicative ((<|>))
import Control.DeepSeq     (NFData (..))
import Data.Bits           ((.&.))
import Data.Char           (ord)
import Data.Hashable       (Hashable (..))
import Data.Text           (Text)
import Data.Time.Compat
       (Year, Day, fromGregorian, gregorianMonthLength, toGregorian)
import Data.Typeable       (Typeable)
import GHC.Generics        (Generic)
import Prelude ()
import Prelude.Compat
import Test.QuickCheck     (Arbitrary (..), arbitraryBoundedEnum)

import qualified Data.Attoparsec.Text     as AT
import qualified Data.Text                as T

#ifdef MIN_VERSION_aeson
import Data.Aeson
       (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..), withText)
import Data.Aeson.Types (FromJSONKeyFunction (..), toJSONKeyText)
#endif

#ifdef MIN_VERSION_intervals
import Numeric.Interval.NonEmpty (Interval, (...))
#endif

-------------------------------------------------------------------------------
-- Month
-------------------------------------------------------------------------------

-- | We explicitly enumerate month names. Using an 'Int' is unsafe.
data MonthName
    = January
    | February
    | March
    | April
    | May
    | June
    | July
    | August
    | September
    | October
    | November
    | December
  deriving (MonthName -> MonthName -> Bool
(MonthName -> MonthName -> Bool)
-> (MonthName -> MonthName -> Bool) -> Eq MonthName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MonthName -> MonthName -> Bool
$c/= :: MonthName -> MonthName -> Bool
== :: MonthName -> MonthName -> Bool
$c== :: MonthName -> MonthName -> Bool
Eq, Eq MonthName
Eq MonthName
-> (MonthName -> MonthName -> Ordering)
-> (MonthName -> MonthName -> Bool)
-> (MonthName -> MonthName -> Bool)
-> (MonthName -> MonthName -> Bool)
-> (MonthName -> MonthName -> Bool)
-> (MonthName -> MonthName -> MonthName)
-> (MonthName -> MonthName -> MonthName)
-> Ord MonthName
MonthName -> MonthName -> Bool
MonthName -> MonthName -> Ordering
MonthName -> MonthName -> MonthName
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 :: MonthName -> MonthName -> MonthName
$cmin :: MonthName -> MonthName -> MonthName
max :: MonthName -> MonthName -> MonthName
$cmax :: MonthName -> MonthName -> MonthName
>= :: MonthName -> MonthName -> Bool
$c>= :: MonthName -> MonthName -> Bool
> :: MonthName -> MonthName -> Bool
$c> :: MonthName -> MonthName -> Bool
<= :: MonthName -> MonthName -> Bool
$c<= :: MonthName -> MonthName -> Bool
< :: MonthName -> MonthName -> Bool
$c< :: MonthName -> MonthName -> Bool
compare :: MonthName -> MonthName -> Ordering
$ccompare :: MonthName -> MonthName -> Ordering
$cp1Ord :: Eq MonthName
Ord, Int -> MonthName -> ShowS
[MonthName] -> ShowS
MonthName -> String
(Int -> MonthName -> ShowS)
-> (MonthName -> String)
-> ([MonthName] -> ShowS)
-> Show MonthName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MonthName] -> ShowS
$cshowList :: [MonthName] -> ShowS
show :: MonthName -> String
$cshow :: MonthName -> String
showsPrec :: Int -> MonthName -> ShowS
$cshowsPrec :: Int -> MonthName -> ShowS
Show, ReadPrec [MonthName]
ReadPrec MonthName
Int -> ReadS MonthName
ReadS [MonthName]
(Int -> ReadS MonthName)
-> ReadS [MonthName]
-> ReadPrec MonthName
-> ReadPrec [MonthName]
-> Read MonthName
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MonthName]
$creadListPrec :: ReadPrec [MonthName]
readPrec :: ReadPrec MonthName
$creadPrec :: ReadPrec MonthName
readList :: ReadS [MonthName]
$creadList :: ReadS [MonthName]
readsPrec :: Int -> ReadS MonthName
$creadsPrec :: Int -> ReadS MonthName
Read, (forall x. MonthName -> Rep MonthName x)
-> (forall x. Rep MonthName x -> MonthName) -> Generic MonthName
forall x. Rep MonthName x -> MonthName
forall x. MonthName -> Rep MonthName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MonthName x -> MonthName
$cfrom :: forall x. MonthName -> Rep MonthName x
Generic, Typeable, MonthName
MonthName -> MonthName -> Bounded MonthName
forall a. a -> a -> Bounded a
maxBound :: MonthName
$cmaxBound :: MonthName
minBound :: MonthName
$cminBound :: MonthName
Bounded)

instance Hashable MonthName where
    hashWithSalt :: Int -> MonthName -> Int
hashWithSalt Int
salt MonthName
m = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt (MonthName -> Int
forall a. Enum a => a -> Int
fromEnum MonthName
m)

instance NFData MonthName where
    rnf :: MonthName -> ()
rnf MonthName
m = MonthName
m MonthName -> () -> ()
`seq` ()

instance Enum MonthName where
    fromEnum :: MonthName -> Int
fromEnum MonthName
January   = Int
1
    fromEnum MonthName
February  = Int
2
    fromEnum MonthName
March     = Int
3
    fromEnum MonthName
April     = Int
4
    fromEnum MonthName
May       = Int
5
    fromEnum MonthName
June      = Int
6
    fromEnum MonthName
July      = Int
7
    fromEnum MonthName
August    = Int
8
    fromEnum MonthName
September = Int
9
    fromEnum MonthName
October   = Int
10
    fromEnum MonthName
November  = Int
11
    fromEnum MonthName
December  = Int
12

    toEnum :: Int -> MonthName
toEnum Int
1  = MonthName
January
    toEnum Int
2  = MonthName
February
    toEnum Int
3  = MonthName
March
    toEnum Int
4  = MonthName
April
    toEnum Int
5  = MonthName
May
    toEnum Int
6  = MonthName
June
    toEnum Int
7  = MonthName
July
    toEnum Int
8  = MonthName
August
    toEnum Int
9  = MonthName
September
    toEnum Int
10 = MonthName
October
    toEnum Int
11 = MonthName
November
    toEnum Int
12 = MonthName
December
    toEnum Int
_  = String -> MonthName
forall a. HasCallStack => String -> a
error String
"toEnum @MonthName: out-of-range"

instance Arbitrary MonthName where
    arbitrary :: Gen MonthName
arbitrary = Gen MonthName
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
    shrink :: MonthName -> [MonthName]
shrink MonthName
January = []
    shrink MonthName
m       = [MonthName
January .. MonthName -> MonthName
forall a. Enum a => a -> a
pred MonthName
m]

instance ToJSON MonthName where
    toJSON :: MonthName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (MonthName -> Text) -> MonthName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthName -> Text
monthNameToText
    toEncoding :: MonthName -> Encoding
toEncoding = Text -> Encoding
forall a. ToJSON a => a -> Encoding
toEncoding (Text -> Encoding) -> (MonthName -> Text) -> MonthName -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthName -> Text
monthNameToText

instance FromJSON MonthName where
    parseJSON :: Value -> Parser MonthName
parseJSON = String -> (Text -> Parser MonthName) -> Value -> Parser MonthName
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"MonthName" ((Text -> Parser MonthName) -> Value -> Parser MonthName)
-> (Text -> Parser MonthName) -> Value -> Parser MonthName
forall a b. (a -> b) -> a -> b
$
        (String -> Parser MonthName)
-> (MonthName -> Parser MonthName)
-> Either String MonthName
-> Parser MonthName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser MonthName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail MonthName -> Parser MonthName
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String MonthName -> Parser MonthName)
-> (Text -> Either String MonthName) -> Text -> Parser MonthName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String MonthName
parseMonthName

instance ToJSONKey MonthName where
    toJSONKey :: ToJSONKeyFunction MonthName
toJSONKey = (MonthName -> Text) -> ToJSONKeyFunction MonthName
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText MonthName -> Text
monthNameToText

instance FromJSONKey MonthName where
    fromJSONKey :: FromJSONKeyFunction MonthName
fromJSONKey = (Text -> Parser MonthName) -> FromJSONKeyFunction MonthName
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser ((Text -> Parser MonthName) -> FromJSONKeyFunction MonthName)
-> (Text -> Parser MonthName) -> FromJSONKeyFunction MonthName
forall a b. (a -> b) -> a -> b
$
        (String -> Parser MonthName)
-> (MonthName -> Parser MonthName)
-> Either String MonthName
-> Parser MonthName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser MonthName
forall (m :: * -> *) a. MonadFail m => String -> m a
fail MonthName -> Parser MonthName
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String MonthName -> Parser MonthName)
-> (Text -> Either String MonthName) -> Text -> Parser MonthName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String MonthName
parseMonthName

-------------------------------------------------------------------------------
-- functions
-------------------------------------------------------------------------------

-- | Extract 'Month' from 'Day'
--
-- >>> dayToYearMonthName (read "2017-02-03")
-- (2017,February)
--
dayToYearMonthName :: Day -> (Year, MonthName)
dayToYearMonthName :: Day -> (Year, MonthName)
dayToYearMonthName Day
d =
    let (Year
y, Int
m, Int
_) = Day -> (Year, Int, Int)
toGregorian Day
d
    in (Year
y, Int -> MonthName
forall a. Enum a => Int -> a
toEnum Int
m)

-- | First day of the month.
--
-- >>> firstDayOfYearMonthName (2017, February)
-- 2017-02-01
--
firstDayOfYearMonthName :: (Year, MonthName) -> Day
firstDayOfYearMonthName :: (Year, MonthName) -> Day
firstDayOfYearMonthName (Year
y, MonthName
m) = Year -> Int -> Int -> Day
fromGregorian Year
y (MonthName -> Int
forall a. Enum a => a -> Int
fromEnum MonthName
m) Int
1

-- | Last day of the month
--
-- >>> lastDayOfYearMonthName (2017, February)
-- 2017-02-28
--
-- >>> lastDayOfYearMonthName (2016, February)
-- 2016-02-29
--
lastDayOfYearMonthName :: (Year, MonthName) -> Day
lastDayOfYearMonthName :: (Year, MonthName) -> Day
lastDayOfYearMonthName (Year
y, MonthName
m) = Year -> Int -> Int -> Day
fromGregorian Year
y Int
m' (Year -> Int -> Int
gregorianMonthLength Year
y Int
m')
  where
    m' :: Int
m' = MonthName -> Int
forall a. Enum a => a -> Int
fromEnum MonthName
m

parseYearMonthName :: Text -> Either String (Year, MonthName)
parseYearMonthName :: Text -> Either String (Year, MonthName)
parseYearMonthName =  Parser (Year, MonthName) -> Text -> Either String (Year, MonthName)
forall a. Parser a -> Text -> Either String a
AT.parseOnly (Parser (Year, MonthName)
 -> Text -> Either String (Year, MonthName))
-> Parser (Year, MonthName)
-> Text
-> Either String (Year, MonthName)
forall a b. (a -> b) -> a -> b
$ do
    Year -> Year
s <- Year -> Year
forall a. Num a => a -> a
negate (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
AT.char Char
'-' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Year -> Year
forall a. a -> a
id (Year -> Year) -> Parser Text Char -> Parser Text (Year -> Year)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Parser Text Char
AT.char Char
'+' Parser Text (Year -> Year)
-> Parser Text (Year -> Year) -> Parser Text (Year -> Year)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Year -> Year) -> Parser Text (Year -> Year)
forall (m :: * -> *) a. Monad m => a -> m a
return Year -> Year
forall a. a -> a
id
    Year
y <- Parser Year
forall a. Integral a => Parser a
AT.decimal
    Char
_ <- Char -> Parser Text Char
AT.char Char
'-'
    Int
m <- Parser Text Int
twoDigits
    if Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
12
    then (Year, MonthName) -> Parser (Year, MonthName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Year -> Year
s Year
y, Int -> MonthName
forall a. Enum a => Int -> a
toEnum Int
m)
    else String -> Parser (Year, MonthName)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid month"
  where
    twoDigits :: Parser Text Int
twoDigits = do
        Char
a <- Parser Text Char
AT.digit
        Char
b <- Parser Text Char
AT.digit
        let c2d :: Char -> Int
c2d Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
15
        Int -> Parser Text Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Text Int) -> Int -> Parser Text Int
forall a b. (a -> b) -> a -> b
$! Char -> Int
c2d Char
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
c2d Char
b

parseMonthName :: Text -> Either String MonthName
parseMonthName :: Text -> Either String MonthName
parseMonthName Text
"jan" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
January
parseMonthName Text
"feb" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
February
parseMonthName Text
"mar" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
March
parseMonthName Text
"apr" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
April
parseMonthName Text
"may" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
May
parseMonthName Text
"jun" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
June
parseMonthName Text
"jul" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
July
parseMonthName Text
"aug" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
August
parseMonthName Text
"sep" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
September
parseMonthName Text
"oct" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
October
parseMonthName Text
"nov" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
November
parseMonthName Text
"dec" = MonthName -> Either String MonthName
forall a b. b -> Either a b
Right MonthName
December
parseMonthName Text
_ = String -> Either String MonthName
forall a b. a -> Either a b
Left String
"Invalid MonthName"

#ifdef MIN_VERSION_intervals
-- | Day interval of month
--
-- >>> yearMonthNameInterval (2017, February)
-- 2017-02-01 ... 2017-02-28
yearMonthNameInterval :: (Year, MonthName) -> Interval Day
yearMonthNameInterval :: (Year, MonthName) -> Interval Day
yearMonthNameInterval (Year, MonthName)
m = (Year, MonthName) -> Day
firstDayOfYearMonthName (Year, MonthName)
m Day -> Day -> Interval Day
forall a. Ord a => a -> a -> Interval a
... (Year, MonthName) -> Day
lastDayOfYearMonthName (Year, MonthName)
m
#endif

-------------------------------------------------------------------------------
-- Internals
-------------------------------------------------------------------------------

monthNameToString :: MonthName -> String
monthNameToString :: MonthName -> String
monthNameToString MonthName
January   = String
"jan"
monthNameToString MonthName
February  = String
"feb"
monthNameToString MonthName
March     = String
"mar"
monthNameToString MonthName
April     = String
"apr"
monthNameToString MonthName
May       = String
"may"
monthNameToString MonthName
June      = String
"jun"
monthNameToString MonthName
July      = String
"jul"
monthNameToString MonthName
August    = String
"aug"
monthNameToString MonthName
September = String
"sep"
monthNameToString MonthName
October   = String
"oct"
monthNameToString MonthName
November  = String
"nov"
monthNameToString MonthName
December  = String
"dec"

monthNameToText :: MonthName -> Text
monthNameToText :: MonthName -> Text
monthNameToText = String -> Text
T.pack (String -> Text) -> (MonthName -> String) -> MonthName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonthName -> String
monthNameToString

yearMonthNameToString :: (Year, MonthName) -> String
yearMonthNameToString :: (Year, MonthName) -> String
yearMonthNameToString (Year
y, MonthName
October)  = Year -> String
forall a. Show a => a -> String
show Year
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-10"
yearMonthNameToString (Year
y, MonthName
November) = Year -> String
forall a. Show a => a -> String
show Year
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-11"
yearMonthNameToString (Year
y, MonthName
December) = Year -> String
forall a. Show a => a -> String
show Year
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-12"
yearMonthNameToString (Year
y, MonthName
m)        = Year -> String
forall a. Show a => a -> String
show Year
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-0" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (MonthName -> Int
forall a. Enum a => a -> Int
fromEnum MonthName
m)

yearMonthNameToText :: (Year, MonthName) -> Text
yearMonthNameToText :: (Year, MonthName) -> Text
yearMonthNameToText = String -> Text
T.pack (String -> Text)
-> ((Year, MonthName) -> String) -> (Year, MonthName) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Year, MonthName) -> String
yearMonthNameToString