refactor code

.github/workflows/cd.yml

@@ -13,7 +13,7 @@ jobs:
     runs-on: ubuntu-latest
 
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
         with:
           ref: ${{ github.head_ref }}
           fetch-depth: 2
@@ -38,34 +38,17 @@ jobs:
           ghc-version: 9.2.8
           cabal-version: 3.10.1.0
 
-      - name: Configure and build
-        run: |
-          cabal configure --enable-tests --enable-benchmarks --disable-documentation
-          cabal build all
+      - name: Build parser
+        run: cabal build
 
       - name: Generate ICS files
         run: cabal run
 
       - name: Commit changes
-        uses: stefanzweifel/git-auto-commit-action@v4
+        uses: stefanzweifel/git-auto-commit-action@v5
         with:
-          file_pattern: docs/*.html docs/*.ics data/*.txt
+          file_pattern: README.md docs/*.ics data/*
           commit_message: update calendar data automatically
           commit_user_name: Muhan Li
           commit_user_email: [email protected]
           commit_author: Muhan Li <[email protected]>
-
-      - name: Get last commit message
-        id: last-commit-message
-        run: echo "msg=$(git log -1 --pretty=%s)" >> $GITHUB_OUTPUT
-
-      - name: Update README
-        uses: stefanzweifel/git-auto-commit-action@v4
-        with:
-          file_pattern: README.md
-          commit_message: ${{ steps.last-commit-message.outputs.msg }}
-          commit_user_name: Muhan Li
-          commit_user_email: [email protected]
-          commit_options: '--amend --no-edit'
-          push_options: '--force'
-          skip_fetch: true

parser.cabal

@@ -24,7 +24,7 @@ description:        Calendar of Public Holidays in China
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version:            0.1.2.0
+version:            0.2.0.0
 
 -- A short (one-line) description of the package.
 -- synopsis:
@@ -54,6 +54,8 @@ build-type:         Simple
 -- Extra source files to be distributed with the package, such as examples, or a tutorial module.
 -- extra-source-files:
 
+-- formatting command: fourmolu --mode inplace $(git ls-files '*.hs') --indentation 2 --indent-wheres true
+
 common warnings
     ghc-options: -Wall
 

parser/Main.hs

@@ -1,5 +1,6 @@
 module Main where
 
+import Data.Function (on)
 import Data.List (isPrefixOf, sortBy)
 import Main.Base
 import Main.Input
@@ -17,26 +18,22 @@ main = do
   contents <- mapM (readFile . ("./data" </>)) files
 
   -- parse data
-  let dataByFile = zip files contents
-  let dataByYear = map parseByFile dataByFile
-  let dataMixed = join dataByYear
-
-  -- debug log
-  debug dataByYear
+  let calendarYearly = zipWith parseFile files contents
+  debug calendarYearly
 
   -- write files
-  writeFile "./docs/index.html" $ icsByType Both dataMixed
+  let calendar = calendarYearly >>= join
+  writeFile "./docs/index.html" $ generate calendar Both
 
-  writeFile "./docs/main.ics" $ icsByType Both dataMixed
-  writeFile "./docs/rest.ics" $ icsByType Rest dataMixed
-  writeFile "./docs/work.ics" $ icsByType Work dataMixed
+  writeFile "./docs/main.ics" $ generate calendar Both
+  writeFile "./docs/rest.ics" $ generate calendar Rest
+  writeFile "./docs/work.ics" $ generate calendar Work
 
 -- Log holiday data ordered by each year
-debug :: [(String, [Date], [Date])] -> IO ()
-debug dataByYear = mapM_ showByYear $ sortByYear data'
-  where
-    data' = map (\(y, r, w) -> (y, sortByDate $ r ++ w)) dataByYear
-    sortByYear = sortBy (\(y1, _) (y2, _) -> compare y1 y2)
-    showByYear (year, dates) = do
-      putStrLn $ "\nYear" <> year
-      mapM_ print dates
+debug :: [Yearly] -> IO ()
+debug yearly =
+  let orderByYear = sortBy (compare `on` year) yearly
+      printByDate holiday = do
+        putStrLn $ "\nYear " ++ year holiday
+        mapM_ print $ sortByDate $ join holiday
+   in mapM_ printByDate orderByYear

parser/Main/Base.hs

@@ -4,47 +4,86 @@ import Data.Function (on)
 import Data.List (sortBy)
 import Data.Time (UTCTime, defaultTimeLocale, formatTime)
 
-data DateType = Both | Rest | Work deriving (Enum)
+data Status = Both | Rest | Work deriving (Enum)
 
-instance Show DateType where
+instance Show Status where
   show Both = ""
   show Rest = "假期"
   show Work = "补班"
 
 -- Title of output ics file
-titleDateType :: DateType -> String
-titleDateType Both = "中国节假日安排"
-titleDateType flag = "中国节假日安排（" <> show flag <> "）"
+titleStatus :: Status -> String
+titleStatus Both = "中国节假日安排"
+titleStatus kind = "中国节假日安排（" ++ show kind ++ "）"
 
 -- Index of input txt file
-indexDateType :: DateType -> Int
-indexDateType Both = 0
-indexDateType Rest = 1
-indexDateType Work = 2
+indexStatus :: Status -> Int
+indexStatus Both = 0
+indexStatus Rest = 1
+indexStatus Work = 2
+
+instance Eq Status where
+  (==) = (==) `on` indexStatus
+
+data Yearly = Yearly
+  { year :: String
+  , rest :: [Holiday]
+  , work :: [Holiday]
+  }
+
+join :: Yearly -> [Holiday]
+join y = rest y ++ work y
+
+data HolidayRaw = HolidayRaw
+  { rawName :: String
+  , rawRest :: String
+  , rawWork :: String
+  }
+
+rawDate :: Status -> HolidayRaw -> String
+rawDate Rest = rawRest
+rawDate Work = rawWork
+rawDate _ = return ""
+
+toHolidayRaw :: [String] -> Maybe HolidayRaw
+toHolidayRaw [n, r, w] = Just $ HolidayRaw n r w
+toHolidayRaw _ = Nothing
+
+data Holiday = Holiday
+  { holidayGroup :: Group
+  , holidayDate :: Date
+  }
+
+instance Show Holiday where
+  show (Holiday group date) = unwords [show date, show group]
+
+toHolidays :: Group -> [Date] -> [Holiday]
+toHolidays group dates = Holiday group <$> dates
+
+data Group = Group
+  { holidayStatus :: Status
+  , holidayName :: String
+  }
+
+instance Show Group where
+  show (Group status name) = unwords [name, show status]
 
 data Date = Date
-  { name :: String,
-    time :: UTCTime,
-    flag :: DateType,
-    index :: Int,
-    total :: Int
+  { holidayIndex :: Int
+  , holidayTotal :: Int
+  , holidayTime :: UTCTime
   }
 
 instance Show Date where
-  show (Date name time flag index total) =
+  show (Date index total time) =
     unwords
-      [ formatTime defaultTimeLocale "%Y-%m-%d" time,
-        name,
-        show flag,
-        show index <> "/" <> show total
+      [ formatTime defaultTimeLocale "%Y-%m-%d" time
+      , show index ++ "/" ++ show total
       ]
 
-constructDate :: String -> DateType -> (Int, Int, UTCTime) -> Date
-constructDate name flag (index, total, time) = Date name time flag index total
-
-sortByDate :: [Date] -> [Date]
-sortByDate = sortBy (compare `on` time)
+sortByDate :: [Holiday] -> [Holiday]
+sortByDate = sortBy (compare `on` holidayTime . holidayDate)
 
-filterByType :: DateType -> [Date] -> [Date]
-filterByType Both = id
-filterByType flag = filter (\(Date _ _ f _ _) -> show f == show flag)
+filterByStatus :: Status -> [Holiday] -> [Holiday]
+filterByStatus Both = id
+filterByStatus kind = filter ((== kind) . holidayStatus . holidayGroup)

parser/Main/Input.hs

@@ -2,60 +2,58 @@ module Main.Input where
 
 import Data.Char (isSpace)
 import Data.List.Split (splitOn)
+import Data.Maybe (mapMaybe)
 import Data.Time (UTCTime, addUTCTime, defaultTimeLocale, formatTime, parseTimeOrError)
 import Main.Base
 import System.FilePath (takeBaseName)
 
--- Join data from each year and each type
-join :: [(String, [Date], [Date])] -> [Date]
-join = concatMap (\ (_, rest, work) -> rest ++ work)
-
 -- Parse holiday data
 -- Organized by year
-parseByFile :: (FilePath, String) -> (String, [Date], [Date])
-parseByFile (file, content) = (year, rest, work)
+parseFile :: FilePath -> String -> Yearly
+parseFile file content = Yearly yearName daysRest daysWork
   where
-    year = takeBaseName file
-    rest = parse content Rest
-    work = parse content Work
+    yearName = takeBaseName file
+    daysRest = parse content Rest
+    daysWork = parse content Work
 
 -- Convert data to Date
-parse :: String -> DateType -> [Date]
-parse content flag = concatMap constructor $ zip (map head raw) dates
+parse :: String -> Status -> [Holiday]
+parse content status = zip names dates >>= uncurry toHolidays
   where
-    constructor (name, dates) = constructDate name flag <$> dates
-    dates = parseDate <$> map (!! indexDateType flag) raw
-    raw = parseFile content
+    names = Group status . rawName <$> raw
+    dates = parseDates . rawDate status <$> raw
+    raw = parseRaw content
 
--- Parse data from file
--- Result: [[Name, RestDays, WorkDays]]
-parseFile :: String -> [[String]]
-parseFile content = filter ((== 3) . length) $ splitOn ";" <$> rawEvents
+-- Parse raw data from file
+-- Format: name;rest;work
+parseRaw :: String -> [HolidayRaw]
+parseRaw content = mapMaybe (toHolidayRaw . splitOn ";") eventsRaw
   where
-    rawEvents = filter (not . null) . map (head . words) $ uncomment
+    eventsRaw = filter (not . null) . map (head . words) $ uncomment
     uncomment = filter (not . null) . map (head . splitOn "//") $ unindent
     unindent = dropWhile isSpace <$> lines content
 
 -- Expand date ranges to UTCTime list
 -- Support multiple date ranges separated by comma
-parseDate :: String -> [(Int, Int, UTCTime)]
-parseDate "" = []
-parseDate range = zip3 [1 ..] (repeat $ length dates) dates
+parseDates :: String -> [Date]
+parseDates ranges = zipWith3 Date [1 ..] (repeat $ length dates) dates
   where
-    dates = concatMap (parseDate' . splitOn "-") $ splitOn "," range
+    dates = splitOn "," ranges >>= parseDate . splitOn "-"
 
 -- Parse date range
 -- 1. like "2020.1.1"
 -- 2. like "2020.1.1-2020.1.3"
-parseDate' :: [String] -> [UTCTime]
-parseDate' [single] = [parseTime single]
-parseDate' [start, end]
-  | start == end = parseDate' [end]
-  | otherwise = first : parseDate' [second, end]
+parseDate :: [String] -> [UTCTime]
+parseDate [""] = []
+parseDate [single] = [parseTime single]
+parseDate [start, end]
+  | start == end = parseDate [end]
+  | otherwise = first : parseDate [second, end]
   where
     first = parseTime start
     second = printTime $ addUTCTime day first
     day = 24 * 60 * 60
+parseDate _ = []
 
 -- Parse date in format "2020.1.1"
 parseTime :: String -> UTCTime

parser/Main/Output.hs

@@ -7,37 +7,37 @@ import Main.Base
 import Text.Printf (printf)
 
 -- Generate ics files
-icsByType :: DateType -> [Date] -> String
-icsByType flag dates = unlines [icsHead flag, icsBody, icsTail]
+generate :: [Holiday] -> Status -> String
+generate dates status = unlines [icsHead status, icsBody, icsTail]
   where
-    icsBody = unlines $ map icsEvent $ sortByDate $ filterByType flag dates
+    icsBody = unlines $ map icsEvent events
+    events = sortByDate $ filterByStatus status dates
 
 -- Standard ics format for the beginning
-icsHead :: DateType -> String
-icsHead flag =
+icsHead :: Status -> String
+icsHead status =
   unlines
-    [ "BEGIN:VCALENDAR",
-      "VERSION:2.0",
-      "PRODID:-//Rank Technology//Chinese Holidays//EN",
-      "X-WR-CALNAME:" <> titleDateType flag
-      -- "X-WR-TIMEZONE:Asia/Shanghai",
+    [ "BEGIN:VCALENDAR"
+    , "VERSION:2.0"
+    , "PRODID:-//Rank Technology//Chinese Holidays//EN"
+    , "X-WR-CALNAME:" ++ titleStatus status
     ]
 
 -- Standard ics format for each event
-icsEvent :: Date -> String
-icsEvent (Date name time flag index total) =
+icsEvent :: Holiday -> String
+icsEvent (Holiday (Group status name) (Date index total time)) =
   unlines
-    [ "BEGIN:VEVENT",
-      "UID:" <> uuid,
-      "DTSTART;VALUE=DATE:" <> formatTime defaultTimeLocale "%Y%m%d" time,
-      "SUMMARY:" <> name <> show flag,
-      "DESCRIPTION:" <> show flag <> printf "第%d天 / 共%d天" index total,
-      "END:VEVENT"
+    [ "BEGIN:VEVENT"
+    , "UID:" ++ uuid
+    , "DTSTART;VALUE=DATE:" ++ formatTime defaultTimeLocale "%Y%m%d" time
+    , "SUMMARY:" ++ name ++ show status
+    , "DESCRIPTION:" ++ show status ++ printf "第%d天 / 共%d天" index total
+    , "END:VEVENT"
     ]
   where
     uuid = toString $ fromWords a b c d
     a = floor . nominalDiffTimeToSeconds . utcTimeToPOSIXSeconds $ time
-    b = fromIntegral $ indexDateType flag
+    b = fromIntegral $ indexStatus status
     c = fromIntegral total
     d = fromIntegral index