Model.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveLift #-}

{-|
Module      : Data.Holiday.Model
Description : Holiday Model
Copyright   : (c) Mo Kweon
License     : MIT
Maintainer  : kkweon@gmail.com
Stability   : experimental
Portability : POSIX

It contains data models for Holiday
-}
module Data.Holiday.Model
  ( Date(..)
  , Holiday(..)
  ) where

import Control.Monad.Extra (liftMaybe)
import Data.Aeson.Types (FromJSON, (.:), parseJSON, withObject)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)
import Text.Read (readMaybe)

data Date
  = YMD (Integer, Int, Int) -- ^ (Year, Month, Day) Some Holiday has a different date every year
  | MD (Int, Int) -- ^ (Month, Day) Some holidays repeat every year on the same date
  deriving (Show, Eq, Lift)

-- | 'Holiday' represents the date of holiday and the name of holiday.
data Holiday =
  Holiday
    { date :: Date -- ^ Date of the holiday
    , name :: String -- ^ Name of the holiday
    }
  deriving (Show, Eq, Generic, Lift)

instance FromJSON Holiday where
  parseJSON =
    withObject "Holiday" $ \v -> Holiday <$> parseDate v <*> v .: "name"
    where
      parseDate o = do
        s <- o .: "date"
        liftMaybe $ parseKoreanDate s

parseKoreanDate :: String -> Maybe Date
parseKoreanDate xs =
  case splitOn "-" xs of
    [y, m, d]
      | verifyYmd y m d -> Just $ YMD (read y, read m, read d)
    [m, d]
      | verifyMd m d -> Just $ MD (read m, read d)
    _ -> Nothing

verifyYmd :: String -> String -> String -> Bool
verifyYmd y m d =
  fromMaybe False $ do
    year <- readMaybe y :: Maybe Integer
    month <- readMaybe m :: Maybe Int
    day <- readMaybe d :: Maybe Int
    return $ isValidYear year && isValidMonth month && isValidDay day

verifyMd :: String -> String -> Bool
verifyMd m d =
  fromMaybe False $ do
    month <- readMaybe m :: Maybe Int
    day <- readMaybe d :: Maybe Int
    return $ isValidMonth month && isValidDay day

isValidYear :: Integer -> Bool
isValidYear y
  | 1900 <= y && y <= 3000 = True
  | otherwise = False

isValidMonth :: Int -> Bool
isValidMonth m
  | 1 <= m && m <= 12 = True
  | otherwise = False

isValidDay :: Int -> Bool
isValidDay d
  | 1 <= d && d <= 31 = True
  | otherwise = False