korea-holidays 0.1.0.3 → 0.1.0.4
raw patch · 6 files changed
+103/−95 lines, 6 filesdep +timePVP: minor bump suggested
API additions: PVP suggests at least a minor version bump
Dependencies added: time
API changes (from Hackage documentation)
+ Data.Holiday.Korea: getNearestHoliday :: Day -> Maybe Holiday
Files
- ChangeLog.md +0/−3
- korea-holidays.cabal +7/−6
- src/Data/Holiday/Korea.hs +26/−20
- src/Data/Holiday/Model.hs +41/−38
- src/Util/Config.hs +2/−2
- test/Data/Holiday/KoreaSpec.hs +27/−26
− ChangeLog.md
@@ -1,3 +0,0 @@-# Changelog for korea-holidays--## Unreleased changes
korea-holidays.cabal view
@@ -4,15 +4,15 @@ -- -- see: https://github.com/sol/hpack ----- hash: f38259eef1c2f67a41fc49b224e7408e8596a6f8568a509f9fc893bc7b39fdcb+-- hash: 1ff53d702584511d74ad7fbc539d9d7d85ff9658bf45d65dd41dff59e67d4310 name: korea-holidays-version: 0.1.0.3+version: 0.1.0.4 synopsis: Korea Holidays description: Please see the README on GitHub at <https://github.com/kkweon/korea-holidays#readme> category: Time-homepage: https://github.com/githubuser/korea-holidays#readme-bug-reports: https://github.com/githubuser/korea-holidays/issues+homepage: https://github.com/kkweon/korea-holidays#readme+bug-reports: https://github.com/kkweon/korea-holidays/issues author: Kyung Mo Kweon maintainer: kkweon@gmail.com copyright: 2019 Kyung Mo Kweon@@ -21,13 +21,12 @@ build-type: Simple extra-source-files: README.md- ChangeLog.md data-files: data/ko_holidays.yaml source-repository head type: git- location: https://github.com/githubuser/korea-holidays+ location: https://github.com/kkweon/korea-holidays library exposed-modules:@@ -44,6 +43,7 @@ , monad-extras , split , template-haskell+ , time , yaml default-language: Haskell2010 @@ -64,5 +64,6 @@ , monad-extras , split , template-haskell+ , time , yaml default-language: Haskell2010
src/Data/Holiday/Korea.hs view
@@ -11,29 +11,35 @@ -} module Data.Holiday.Korea where -import Data.Aeson.Types ( FromJSON- , (.:)- , parseJSON- , withObject- )-import Data.Holiday.Model ( Date(..)- , Holiday(..)- )-import Data.Maybe ( fromJust- , listToMaybe- )-import Util.Config ( holidays )+import Data.Holiday.Model (Date(..), Holiday(..))+import Data.Maybe (listToMaybe)+import Util.Config (holidays) +import Control.Monad (msum)++import qualified Data.Time as Time+ -- | 'getHoliday' returns Nothing if there is no Korean holiday.-getHoliday- :: Integer -- ^ Year+getHoliday ::+ Integer -- ^ Year -> Int -- ^ Month -> Int -- ^ Day -> Maybe Holiday getHoliday year month day = listToMaybe $ filter match holidays- where- match :: Holiday -> Bool- match Holiday { date = YMD (y, m, d) } | y == year && m == month && d == day =- True- match Holiday { date = MD (m, d) } | m == month && d == day = True- match _ = False+ where+ match :: Holiday -> Bool+ match Holiday {date = YMD (y, m, d)}+ | y == year && m == month && d == day = True+ match Holiday {date = MD (m, d)}+ | m == month && d == day = True+ match _ = False++-- | `getNearestHoliday` returns a nearest holiday within a year range+getNearestHoliday :: Time.Day -> Maybe Holiday+getNearestHoliday day = msum . map go $ [0 .. 365]+ where+ go :: Integer -> Maybe Holiday+ go delta =+ let newDay = Time.addDays delta day+ (y, m, d) = Time.toGregorian newDay+ in getHoliday y m d
src/Data/Holiday/Model.hs view
@@ -16,22 +16,15 @@ module Data.Holiday.Model ( Date(..) , Holiday(..)- )-where+ ) where -import Control.Monad.Extra ( liftMaybe )-import Data.Aeson.Types ( FromJSON- , Parser- , (.:)- , (.:?)- , 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 )+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@@ -39,10 +32,12 @@ 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)+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 =@@ -53,32 +48,40 @@ 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+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+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+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+isValidYear y+ | 1900 <= y && y <= 3000 = True+ | otherwise = False isValidMonth :: Int -> Bool-isValidMonth m | 1 <= m && m <= 12 = True- | otherwise = False+isValidMonth m+ | 1 <= m && m <= 12 = True+ | otherwise = False isValidDay :: Int -> Bool-isValidDay d | 1 <= d && d <= 31 = True- | otherwise = False+isValidDay d+ | 1 <= d && d <= 31 = True+ | otherwise = False
src/Util/Config.hs view
@@ -2,8 +2,8 @@ module Util.Config where -import Data.Yaml.TH ( decodeFile )-import qualified Data.Holiday.Model as K+import qualified Data.Holiday.Model as K+import Data.Yaml.TH (decodeFile) holidays :: [K.Holiday] holidays = $$(decodeFile "data/ko_holidays.yaml")
test/Data/Holiday/KoreaSpec.hs view
@@ -1,31 +1,32 @@ module Data.Holiday.KoreaSpec where -import qualified Data.Holiday.Korea as Korea-import qualified Data.Holiday.Model as KM+import qualified Data.Holiday.Korea as Korea+import qualified Data.Holiday.Model as KM -import Data.Holiday.Model ( date- , name- )-import Test.Hspec ( Spec- , describe- , it- , shouldBe- )+import qualified Data.Time as Time +import Data.Holiday.Model (date, name)+import Test.Hspec (Spec, describe, it, shouldBe)+ spec :: Spec-spec = describe "Data.Holiday.Korea" $ do- it "returns New Year's Day when 2000/1/1"- $ Korea.getHoliday 2000 1 1- `shouldBe` Just KM.Holiday {date = KM.MD (1, 1), name = "New Year's Day"}- it "returns March 1 Movement Day when 2019/3/1"- $ Korea.getHoliday 2019 3 1- `shouldBe` Just KM.Holiday- { date = KM.MD (3, 1)- , name = "March 1 Movement Day"- }- it "returns Chuseok when 2029/09/22"- $ Korea.getHoliday 2029 9 22- `shouldBe` Just KM.Holiday {date = KM.YMD (2029, 9, 22), name = "Chuseok"}- it "returns Nothing when it's not a Holiday 2019/07/04"- $ Korea.getHoliday 2019 7 4- `shouldBe` Nothing+spec =+ describe "Data.Holiday.Korea" $ do+ it "returns New Year's Day when 2000/1/1" $+ Korea.getHoliday 2000 1 1 `shouldBe`+ Just KM.Holiday {date = KM.MD (1, 1), name = "New Year's Day"}+ it "returns March 1 Movement Day when 2019/3/1" $+ Korea.getHoliday 2019 3 1 `shouldBe`+ Just KM.Holiday {date = KM.MD (3, 1), name = "March 1 Movement Day"}+ it "returns Chuseok when 2029/09/22" $+ Korea.getHoliday 2029 9 22 `shouldBe`+ Just KM.Holiday {date = KM.YMD (2029, 9, 22), name = "Chuseok"}+ it "returns Nothing when it's not a Holiday 2019/07/04" $+ Korea.getHoliday 2019 7 4 `shouldBe` Nothing+ it "returns a nearest holiday when is given 2029/09/21" $+ let day = Time.fromGregorian 2029 9 21+ in Korea.getNearestHoliday day `shouldBe`+ Just KM.Holiday {date = KM.YMD (2029, 9, 22), name = "Chuseok"}+ it "returns a exact holiday when it's 2019/3/1" $+ let day = Time.fromGregorian 2019 3 1+ in Korea.getNearestHoliday day `shouldBe`+ Just KM.Holiday {date = KM.MD (3, 1), name = "March 1 Movement Day"}