update ci and tests

.github/workflows/ci.yml

@@ -9,8 +9,76 @@ on:
       - "**"
 
 jobs:
-  build:
+  crawler:
-    name: Build
+    name: Crawler Dry Run
+    runs-on: ubuntu-latest
+    strategy:
+      matrix:
+        python-version: ["3.11", "3.12", "3.13-dev"]
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Setup Python ${{ matrix.python-version }}
+        uses: actions/setup-python@v4
+        with:
+          python-version: ${{ matrix.python-version }}
+
+      - name: Install Python dependencies
+        run: |
+          python -m pip install --upgrade pip
+          if [ -f requirements.txt ]; then pip install -r requirements.txt; fi
+
+      - name: Run crawler script
+        shell: bash
+        run: python crawler.py
+
+  parser:
+    name: Parser Dry Run
+    runs-on: ubuntu-latest
+
+    strategy:
+      matrix:
+        ghc: ["9.2.8", "9.6", "latest"]
+        cabal: ["3.10.1.0", "3.10", "latest"]
+        exclude:
+          - ghc: latest
+            cabal: 3.10.1.0
+
+    steps:
+      - uses: actions/checkout@v4
+
+      - name: Setup Haskell ${{ matrix.ghc }} with Cabal ${{ matrix.cabal }}
+        uses: haskell-actions/setup@v2
+        with:
+          ghc-version: ${{ matrix.ghc }}
+          cabal-version: ${{ matrix.cabal }}
+
+      - name: Configure the build
+        run: |
+          cabal configure --enable-tests --enable-benchmarks --disable-documentation
+          cabal build --dry-run
+
+      - name: Build
+        run: cabal build all
+
+      - name: Run tests
+        run: cabal test all
+
+      - name: Check cabal file
+        run: cabal check
+
+      - name: Run parser
+        run: cabal run
+
+      - name: Checkout files
+        run: |
+          pwd
+          ls -la
+          ls -la docs
+
+  hlint:
+    name: HLint
     runs-on: ubuntu-latest
 
     defaults:
@@ -18,24 +86,16 @@ jobs:
         working-directory: .
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
 
-      - name: Setup Go
+      - name: "Set up HLint"
-        uses: actions/setup-go@v4
+        uses: haskell-actions/hlint-setup@v2
+
+      - name: "Run HLint"
+        uses: haskell-actions/hlint-run@v2
         with:
-          go-version-file: go.mod
+          path: parser/
-
+          fail-on: warning
-      - name: Go Build
-        run: go build -v ./...
-
-      - name: Go Test
-        run: go test ./... -shuffle on -count 10 -coverprofile cover.out
-
-      - name: Go Vet
-        run: go test -v ./... -vet all
-
-      - name: Coverage
-        run: go tool cover -func cover.out
 
   golint:
     name: Golint
@@ -53,21 +113,21 @@ jobs:
   pylint:
     name: Pylint
     runs-on: ubuntu-latest
-    strategy:
-      matrix:
-        python-version: [ "3.11", "3.12" ]
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
-      - name: Set up Python ${{ matrix.python-version }}
+
+      - name: Set up Python Environment
         uses: actions/setup-python@v4
         with:
-          python-version: ${{ matrix.python-version }}
+          python-version: 3.12
-      - name: Install dependencies
+
+      - name: Install Python dependencies
         run: |
           python -m pip install --upgrade pip
           pip install pylint
           if [ -f requirements.txt ]; then pip install -r requirements.txt; fi
-      - name: Analysing the code with pylint
+
+      - name: Analyzing the code with pylint
         run: |
           pylint $(git ls-files '*.py')

parser.cabal

@@ -12,6 +12,10 @@ cabal-version:      3.0
 --
 -- The name of the package.
 name:               parser
+category:           Data
+synopsis:           Chinese Holidays Calendar Parser and Generator
+description:        Calendar of Public Holidays in China
+                    中国大陆节假日日历订阅
 
 -- The package version.
 -- See the Haskell package versioning policy (PVP) for standards
@@ -20,7 +24,7 @@ name:               parser
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version:            0.1.0.0
+version:            0.1.1.0
 
 -- A short (one-line) description of the package.
 -- synopsis:
@@ -53,7 +57,7 @@ build-type:         Simple
 common warnings
     ghc-options: -Wall
 
-executable temp
+executable main
     -- Import common warning flags.
     import:           warnings
 
@@ -67,10 +71,33 @@ executable temp
     -- other-extensions:
 
     -- Other library packages from which modules are imported.
-    build-depends:    base ^>=4.16.4.0, directory, filepath, split, time, uuid
+    build-depends:    base >= 4.16.4.0 && < 4.20,
+                      directory >= 1.3.6 && < 1.4,
+                      filepath >= 1.4.2 && < 1.5,
+                      split >= 0.2.4 && < 0.3,
+                      time >= 1.11.1 && < 1.12,
+                      uuid >= 1.3.15 && < 1.4
 
     -- Directories containing source files.
     hs-source-dirs:   parser
 
     -- Base language which the package is written in.
     default-language: Haskell2010
+
+test-suite test
+  type:                exitcode-stdio-1.0
+  main-is:             Test.hs
+  other-modules:       Main.Base Main.Input Main.Output
+  build-depends:       base >=4.16.4.0 && <4.20,
+                       directory >= 1.3.6 && < 1.4,
+                       filepath >= 1.4.2 && < 1.5,
+                       split >= 0.2.4 && < 0.3,
+                       time >= 1.11.1 && < 1.12,
+                       uuid >= 1.3.15 && < 1.4,
+                       HUnit >=1.6 && <1.7
+  hs-source-dirs:      parser
+  default-language:    Haskell2010
+
+source-repository head
+  type:     git
+  location: https://github.com/theRank/chinese-holidays-calendar

parser/Main.hs

@@ -38,5 +38,5 @@ debug dataByYear = mapM_ showByYear $ sortByYear data'
     data' = map (\(y, r, w) -> (y, sortByDate $ r ++ w)) dataByYear
     sortByYear = sortBy (\(y1, _) (y2, _) -> compare y1 y2)
     showByYear (year, dates) = do
-      putStrLn $ "\nYear " ++ year
+      putStrLn $ "\nYear" <> year
-      mapM (putStrLn . show) dates
+      mapM_ print dates

parser/Main/Base.hs

@@ -1,49 +1,50 @@
 module Main.Base where
 
-import Data.List (intercalate, sortBy)
+import Data.Function (on)
+import Data.List (sortBy)
 import Data.Time (UTCTime, defaultTimeLocale, formatTime)
 
-data DateDataType = Both | Rest | Work deriving (Enum)
+data DateType = Both | Rest | Work deriving (Enum)
 
-instance Show DateDataType where
+instance Show DateType where
   show Both = ""
   show Rest = "假期"
   show Work = "补班"
 
 -- Title of output ics file
-titleDateDataType :: DateDataType -> String
+titleDateType :: DateType -> String
-titleDateDataType Both = "节假日"
+titleDateType Both = "中国节假日安排"
-titleDateDataType flag = "节假日（" ++ show flag ++ "）"
+titleDateType flag = "中国节假日安排（" <> show flag <> "）"
 
 -- Index of input txt file
-indexDateDataType :: DateDataType -> Int
+indexDateType :: DateType -> Int
-indexDateDataType Both = 0
+indexDateType Both = 0
-indexDateDataType Rest = 1
+indexDateType Rest = 1
-indexDateDataType Work = 2
+indexDateType Work = 2
 
 data Date = Date
   { name :: String,
     time :: UTCTime,
-    flag :: DateDataType,
+    flag :: DateType,
     index :: Int,
     total :: Int
   }
 
 instance Show Date where
   show (Date name time flag index total) =
-    intercalate " " $
+    unwords
       [ formatTime defaultTimeLocale "%Y-%m-%d" time,
         name,
         show flag,
-        show index ++ "/" ++ show total
+        show index <> "/" <> show total
       ]
 
-constructDate :: String -> DateDataType -> (Int, Int, UTCTime) -> Date
+constructDate :: String -> DateType -> (Int, Int, UTCTime) -> Date
 constructDate name flag (index, total, time) = Date name time flag index total
 
 sortByDate :: [Date] -> [Date]
-sortByDate = sortBy (\(Date _ t1 _ _ _) (Date _ t2 _ _ _) -> compare t1 t2)
+sortByDate = sortBy (compare `on` time)
 
-filterByType :: DateDataType -> [Date] -> [Date]
+filterByType :: DateType -> [Date] -> [Date]
 filterByType Both = id
-filterByType flag = filter (\(Date _ _ f _ _) -> indexDateDataType f == indexDateDataType flag)
+filterByType flag = filter (\(Date _ _ f _ _) -> show f == show flag)

parser/Main/Input.hs

@@ -1,5 +1,6 @@
 module Main.Input where
 
+import Data.Char (isSpace)
 import Data.List.Split (splitOn)
 import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, parseTimeOrError)
 import Main.Base
@@ -7,7 +8,7 @@ import System.FilePath (takeBaseName)
 
 -- Join data from each year and each type
 join :: [(String, [Date], [Date])] -> [Date]
-join dataByFile = concatMap (\(_, rest, work) -> rest ++ work) dataByFile
+join = concatMap (\ (_, rest, work) -> rest ++ work)
 
 -- Parse holiday data
 -- Organized by year
@@ -19,21 +20,21 @@ parseByFile (file, content) = (year, rest, work)
     work = parse year content Work
 
 -- Convert data to Date
-parse :: String -> String -> DateDataType -> [Date]
+parse :: String -> String -> DateType -> [Date]
 parse year content flag = concatMap constructor $ zip (map head raw) dates
   where
-    constructor (name, dates) = map (constructDate name flag) dates
+    constructor (name, dates) = constructDate name flag <$> dates
-    dates = map parseDate $ map (!! indexDateDataType flag) raw
+    dates = parseDate <$> map (!! indexDateType flag) raw
     raw = parseFile content
 
 -- Parse data from file
 -- Result: [[Name, RestDays, WorkDays]]
 parseFile :: String -> [[String]]
-parseFile content = holidays
+parseFile content = filter ((== 3) . length) $ splitOn ";" <$> rawEvents
   where
-    holidays = filter ((== 3) . length) . map (splitOn ";") $ eachData
+    rawEvents = filter (not . null) . map (head . words) $ uncomment
-    eachData = filter (not . null) . map (head . words) $ eachLine
+    uncomment = filter (not . null) . map (head . splitOn "//") $ unindent
-    eachLine = filter (not . null) . map (head . splitOn "//") $ lines content
+    unindent = dropWhile isSpace <$> lines content
 
 -- Expand date ranges to UTCTime list
 -- Support multiple date ranges separated by comma
@@ -47,17 +48,18 @@ parseDate range = zip3 [1 ..] (repeat $ length dates) dates
 -- 1. like "2020.1.1"
 -- 2. like "2020.1.1-2020.1.3"
 parseDate' :: [String] -> [UTCTime]
-parseDate' [date] = [parseTime date]
+parseDate' [single] = [parseTime single]
 parseDate' [start, end]
   | start == end = parseDate' [end]
   | otherwise = first : parseDate' [second, end]
   where
     first = parseTime start
-    second = printTime $ addUTCTime 86400 first
+    second = printTime $ addUTCTime day first
+    day = 24 * 60 * 60
 
 -- Parse date in format "2020.1.1"
 parseTime :: String -> UTCTime
-parseTime date = parseTimeOrError True defaultTimeLocale "%Y.%-m.%-d" date :: UTCTime
+parseTime = parseTimeOrError True defaultTimeLocale "%Y.%-m.%-d"
 
 -- Format date in format "2020.1.1"
 printTime :: UTCTime -> String

parser/Main/Output.hs

@@ -2,24 +2,24 @@ module Main.Output where
 
 import Data.Time (defaultTimeLocale, formatTime, nominalDiffTimeToSeconds)
 import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
-import Data.UUID (fromWords64, toString)
+import Data.UUID (fromWords, toString)
 import Main.Base
 import Text.Printf (printf)
 
 -- Generate ics files
-icsByType :: DateDataType -> [Date] -> String
+icsByType :: DateType -> [Date] -> String
 icsByType flag dates = unlines [icsHead flag, icsBody, icsTail]
   where
     icsBody = unlines $ map icsEvent $ sortByDate $ filterByType flag dates
 
 -- Standard ics format for the beginning
-icsHead :: DateDataType -> String
+icsHead :: DateType -> String
 icsHead flag =
   unlines
     [ "BEGIN:VCALENDAR",
       "VERSION:2.0",
       "PRODID:-//Rank Technology//Chinese Holidays//EN",
-      "X-WR-CALNAME:" ++ titleDateDataType flag
+      "X-WR-CALNAME:" <> titleDateType flag
       -- "X-WR-TIMEZONE:Asia/Shanghai",
     ]
 
@@ -28,15 +28,18 @@ icsEvent :: Date -> String
 icsEvent (Date name time flag index total) =
   unlines
     [ "BEGIN:VEVENT",
-      "UID:" ++ uuid,
+      "UID:" <> uuid,
-      "DTSTART;VALUE=DATE:" ++ formatTime defaultTimeLocale "%Y%m%d" time,
+      "DTSTART;VALUE=DATE:" <> formatTime defaultTimeLocale "%Y%m%d" time,
-      "SUMMARY:" ++ name ++ show flag,
+      "SUMMARY:" <> name <> show flag,
-      "DESCRIPTION:" ++ printf "%s 第%d天/共%d天" (show flag) index total,
+      "DESCRIPTION:" <> show flag <> printf "第%d天 / 共%d天" index total,
       "END:VEVENT"
     ]
   where
-    uuid = toString $ fromWords64 1 t
+    uuid = toString $ fromWords a b c d
-    t = floor $ nominalDiffTimeToSeconds $ utcTimeToPOSIXSeconds time
+    a = floor . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds $ time
+    b = fromIntegral $ indexDateType flag
+    c = fromIntegral total
+    d = fromIntegral index
 
 -- Standard ics format for the ending
 icsTail :: String

parser/Test.hs

@@ -0,0 +1,213 @@
+module Main where
+
+import Main.Input
+import System.Exit (exitFailure, exitSuccess)
+import Test.HUnit
+
+testA1 =
+  TestCase
+    ( assertEqual
+        "A1 - case 1. like 2020.1.1 - basic"
+        ["2020.1.1"]
+        $ map printTime
+        $ parseDate' ["2020.1.1"]
+    )
+
+testA2 =
+  TestCase
+    ( assertEqual
+        "A2 - case 1. like 2020.1.1 - robust"
+        ["2021.11.2"]
+        (map printTime $ parseDate' ["2021.11.02"])
+    )
+
+testA3 =
+  TestCase
+    ( assertEqual
+        "A3 - case 2. like 2020.1.1-2020.1.3 - basic"
+        ["2022.1.1", "2022.1.2", "2022.1.3"]
+        (map printTime $ parseDate' ["2022.1.1", "2022.1.3"])
+    )
+
+testA4 =
+  TestCase
+    ( assertEqual
+        "A4 - case 2. like 2020.1.1-2020.1.3 - cross month"
+        ["2023.2.27", "2023.2.28", "2023.3.1", "2023.3.2"]
+        (map printTime $ parseDate' ["2023.2.27", "2023.3.2"])
+    )
+
+testA5 =
+  TestCase
+    ( assertEqual
+        "A5 - case 2. like 2020.1.1-2020.1.3 - cross month 2"
+        ["2024.2.28", "2024.2.29", "2024.3.1"]
+        (map printTime $ parseDate' ["2024.2.28", "2024.3.1"])
+    )
+
+testA6 =
+  TestCase
+    ( assertEqual
+        "A6 - case 2. like 2020.1.1-2020.1.3 - cross year"
+        ["2025.12.30", "2025.12.31", "2026.1.1", "2026.1.2"]
+        (map printTime $ parseDate' ["2025.12.30", "2026.1.2"])
+    )
+
+testB1 =
+  TestCase
+    ( assertEqual
+        "B1 - case 1. like 2020.1.1 - a1 2"
+        [(1, 2, "2020.1.1"), (2, 2, "2020.1.3")]
+        $ map (\(a, b, c) -> (a, b, printTime c))
+        $ parseDate "2020.1.1,2020.1.3"
+    )
+
+testB2 =
+  TestCase
+    ( assertEqual
+        "B2 - case 1. like 2020.1.1 - a1 3"
+        [(1, 3, "2020.1.1"), (2, 3, "2020.1.3"), (3, 3, "2020.1.5")]
+        $ map (\(a, b, c) -> (a, b, printTime c))
+        $ parseDate "2020.1.1,2020.1.3,2020.1.5"
+    )
+
+testB3 =
+  TestCase
+    ( assertEqual
+        "B3 - case 2. like 2020.1.1-2020.1.3 - a3 2"
+        [(1, 4, "2020.1.1"), (2, 4, "2020.1.2"), (3, 4, "2020.1.6"), (4, 4, "2020.1.7")]
+        $ map (\(a, b, c) -> (a, b, printTime c))
+        $ parseDate "2020.1.1-2020.1.2,2020.1.6-2020.1.7"
+    )
+
+testB4 =
+  TestCase
+    ( assertEqual
+        "B4 - case 2. like 2020.1.1-2020.1.3 - a1 a3"
+        [(1, 4, "2020.1.1"), (2, 4, "2020.1.2"), (3, 4, "2020.1.3"), (4, 4, "2020.1.6")]
+        $ map (\(a, b, c) -> (a, b, printTime c))
+        $ parseDate "2020.1.1-2020.1.3,2020.1.6"
+    )
+
+testB5 =
+  TestCase
+    ( assertEqual
+        "B5 - case 2. like 2020.1.1-2020.1.3 - a3 a1"
+        [(1, 5, "2019.12.6"), (2, 5, "2020.1.1"), (3, 5, "2020.1.2"), (4, 5, "2020.1.3"), (5, 5, "2021.11.11")]
+        $ map (\(a, b, c) -> (a, b, printTime c))
+        $ parseDate "2019.12.6,2020.1.1-2020.1.3,2021.11.11"
+    )
+
+testC1 =
+  TestCase
+    ( assertEqual
+        "C1 - data - basic"
+        [["a", "b", "c"]]
+        $ parseFile "a;b;c"
+    )
+
+testC2 =
+  TestCase
+    ( assertEqual
+        "C2 - data - robust"
+        [["a12", "b345", "c678"]]
+        $ parseFile "   a12;b345;c678    "
+    )
+
+testC3 =
+  TestCase
+    ( assertEqual
+        "C3 - comments - basic"
+        []
+        $ parseFile "//comment"
+    )
+
+testC4 =
+  TestCase
+    ( assertEqual
+        "C4 - comments - robust"
+        []
+        $ parseFile "   // a;b;c  123  "
+    )
+
+testC5 =
+  TestCase
+    ( assertEqual
+        "C5 - hybrid - basic"
+        [["a", "b", "c"]]
+        $ parseFile "a;b;c  // d;e;f  456  "
+    )
+
+testC6 =
+  TestCase
+    ( assertEqual
+        "C6 - hybrid - robust"
+        [["a", "b", "c"]]
+        $ parseFile "   a;b;c 123 // d;e;f  456  "
+    )
+
+testC7 =
+  TestCase
+    ( assertEqual
+        "C7 - empty - basic"
+        []
+        $ parseFile ""
+    )
+
+testC8 =
+  TestCase
+    ( assertEqual
+        "C8 - empty - robust"
+        []
+        $ parseFile "  //   "
+    )
+
+testC9 =
+  TestCase
+    ( assertEqual
+        "C9 - multi-line"
+        [["a", "b", "c"], ["d", "e", "f"]]
+        $ parseFile . unlines
+        $ [ "// INTRO",
+            "",
+            "a;b;c // dp1",
+            "// comment",
+            "d;e;f // dp2",
+            "END  // TEST"
+          ]
+    )
+
+tests :: Test
+tests =
+  TestList
+    [ -- A. parseDate'
+      TestLabel "Test parseDate' 1" testA1,
+      TestLabel "Test parseDate' 2" testA2,
+      TestLabel "Test parseDate' 3" testA3,
+      TestLabel "Test parseDate' 4" testA4,
+      TestLabel "Test parseDate' 5" testA5,
+      TestLabel "Test parseDate' 6" testA6,
+      -- B. parseDate
+      TestLabel "Test parseDate 1" testB1,
+      TestLabel "Test parseDate 2" testB2,
+      TestLabel "Test parseDate 3" testB3,
+      TestLabel "Test parseDate 4" testB4,
+      TestLabel "Test parseDate 5" testB5,
+      -- C. parseFile
+      TestLabel "Test parseFile 1" testC1,
+      TestLabel "Test parseFile 2" testC2,
+      TestLabel "Test parseFile 3" testC3,
+      TestLabel "Test parseFile 4" testC4,
+      TestLabel "Test parseFile 5" testC5,
+      TestLabel "Test parseFile 6" testC6,
+      TestLabel "Test parseFile 7" testC7,
+      TestLabel "Test parseFile 8" testC8,
+      TestLabel "Test parseFile 9" testC9
+    ]
+
+main :: IO ()
+main = do
+  counts <- runTestTT tests
+  if errors counts + failures counts == 0
+    then exitSuccess
+    else exitFailure