{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveLift #-}
module Data.Holiday.Model
( Date(..)
, Holiday(..)
) where
import Control.Monad.Extra (liftMaybe)
import Data.Aeson.Types (FromJSON, (.:), (.:?), parseJSON, withObject, Parser)
import Data.List.Split (splitOn)
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)
import Text.Read (readMaybe)
import Language.Haskell.TH.Syntax (Lift)
data Date
= YMD (Integer, Int, Int)
| MD (Int, Int)
deriving (Show, Eq, Lift)
data Holiday = Holiday
{ date :: Date
, name :: String
, lunar :: Maybe Bool
} deriving (Show, Eq, Generic, Lift)
instance FromJSON Holiday where
parseJSON =
withObject "Holiday" $ \v -> Holiday
<$> parseDate v
<*> v .: "name"
<*> v .:? "lunar"
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