packages feed

korea-holidays (empty) → 0.1.0.0

raw patch · 10 files changed

+274/−0 lines, 10 filesdep +aesondep +basedep +hspecsetup-changed

Dependencies added: aeson, base, hspec, korea-holidays, monad-extras, split, template-haskell, yaml

Files

+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for korea-holidays++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2019 Mo Kweon++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,27 @@+# korea-holidays++[![Build Status](https://travis-ci.com/kkweon/korea-holidays.svg?branch=master)](https://travis-ci.com/kkweon/korea-holidays)++*korea-holidays* is a Haskell library to check if a given date is a Korean+Holiday.++## Usage++```haskell+import qualified Data.Holiday.Korea as Korea++Korea.getHoliday 2000 1 1 `shouldBe` Just Korea.Holiday+  { Korea.date = Korea.MD (1, 1)+  , Korea.name = "SinJeong"+  }+```++## Add to your dependency++In your `package.yaml`++```yaml+library:+  dependencies:+  - korea-holidays+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ korea-holidays.cabal view
@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: a8d419efde392376f47b6becba96f548c6574a9663ce5c0a39e936a018a86b3d++name:           korea-holidays+version:        0.1.0.0+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+author:         Kyung Mo Kweon+maintainer:     kkweon@gmail.com+copyright:      2019 Kyung Mo Kweon+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++source-repository head+  type: git+  location: https://github.com/githubuser/korea-holidays++library+  exposed-modules:+      Data.Holiday.Korea+      Data.Holiday.Model+  other-modules:+      Util.Config+      Paths_korea_holidays+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , monad-extras+    , split+    , template-haskell+    , yaml+  default-language: Haskell2010++test-suite korea-holidays-test+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Data.Holiday.KoreaSpec+      Paths_korea_holidays+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      aeson+    , base >=4.7 && <5+    , hspec+    , korea-holidays+    , monad-extras+    , split+    , template-haskell+    , yaml+  default-language: Haskell2010
+ src/Data/Holiday/Korea.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module      : Data.Holiday.Korea+Description : The module contains Korea Holidays+Copyright   : (c) Kyung Mo Kweon+License     : BSD+Maintainer  : kkweon@gmail.com+Stability   : experimental+Portability : POSIX++The module contains Korea Holidays+-}+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)++-- | 'getHoliday' returns Nothing if there is no Korean holiday.+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
+ src/Data/Holiday/Model.hs view
@@ -0,0 +1,91 @@+{-# 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, 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) -- ^ (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+  , lunar :: Maybe Bool -- ^ Date maybe Lunar Date+  } 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
+ src/Util/Config.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}++module Util.Config where++import Data.Yaml.TH (decodeFile)+import qualified Data.Holiday.Model as K++holidays :: [K.Holiday]+holidays = $$(decodeFile "data/ko_holidays.yaml")
+ test/Data/Holiday/KoreaSpec.hs view
@@ -0,0 +1,20 @@+module Data.Holiday.KoreaSpec where++import qualified Data.Holiday.Korea as Korea+import qualified Data.Holiday.Model as KM+import Data.Holiday.Model (date, lunar, name)+import Test.Hspec (Spec, describe, it, shouldBe)++spec :: Spec+spec =+  describe "Data.Holiday.Korea" $ do+    it "returns a SinJeong when xxxx/1/1" $+      Korea.getHoliday 2000 1 1 `shouldBe`+      Just+        KM.Holiday+          {date = KM.MD (1, 1), name = "New Year's Day", lunar = Nothing}+    it "returns the Independence Movement Day 3/1" $+      Korea.getHoliday 2019 3 1 `shouldBe`+      Just+        KM.Holiday+          {date = KM.MD (3, 1), name = "March 1 Movement Day", lunar = Nothing}
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}