Skip to content

Commit e3d02cf

Browse files
usefulalgorithmCopilot
usefulalgorithm
and
Copilot
authored
feat: monthly album digest (#92)
* feat: monthly digest Signed-off-by: Tsung-Ju Lii <[email protected]> * feat: run it in a workflow Signed-off-by: Tsung-Ju Lii <[email protected]> * nit: drop comment Signed-off-by: Tsung-Ju Lii <[email protected]> * Update .github/workflows/monthly_album_digest.yaml Co-authored-by: Copilot <[email protected]> --------- Signed-off-by: Tsung-Ju Lii <[email protected]> Co-authored-by: Copilot <[email protected]>
1 parent 3230097 commit e3d02cf

File tree

5 files changed

+223
-0
lines changed

5 files changed

+223
-0
lines changed

‎.github/workflows/monthly_album_digest.yaml‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
name: Monthly Album Digest
2+
description: Creates an album digest from last month, and send it to my email.
3+
4+
on:
5+
workflow_dispatch:
6+
schedule:
7+
- cron: '0 0 1 * *'
8+
jobs:
9+
create-branch-and-pr:
10+
runs-on: ubuntu-latest
11+
environment: deployment
12+
13+
steps:
14+
- name: Checkout repository
15+
uses: actions/checkout@v4
16+
17+
- id: stack
18+
uses: freckle/stack-action@v5
19+
with:
20+
stack-build-arguments: --fast # No pedantic for now
21+
22+
- id: run
23+
run: echo "text=$(stack exec monthly-rewind)" >> $GITHUB_OUTPUT
24+
- name: Send Email
25+
run: |
26+
curl -s --user 'api:${{ secrets.MAILGUN_API_KEY }}' \
27+
https://api.mailgun.net/v3/${{ secrets.MAILGUN_SERVER }}/messages \
28+
-F from='Mailgun Sandbox <postmaster@${{ secrets.MAILGUN_SERVER }}>' \
29+
-F to='Tsung-Ju Lii <[email protected]>' \
30+
-F subject='Monthly Digest' \
31+
-F text='${{ steps.run.outputs.text }}'
32+

‎scripts/monthly_rewind/app/Main.hs‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,107 @@
1+
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
4+
module Main where
5+
6+
import Data.List (sortBy)
7+
import Data.List.Split (splitOn)
8+
import Data.Maybe (catMaybes)
9+
import Data.Ord (Down (Down), comparing)
10+
import qualified Data.Text as T
11+
import Data.Time (fromGregorian)
12+
import Data.Time.Calendar (Day, addGregorianMonthsClip,
13+
toGregorian)
14+
import Data.Time.Clock (getCurrentTime, utctDay)
15+
import System.Directory (listDirectory)
16+
import Text.Pandoc (Inline (Space, Str),
17+
Pandoc (Pandoc), readMarkdown,
18+
runIO)
19+
import Text.Pandoc.Options
20+
import Text.Pandoc.Writers.Shared (lookupMetaInlines)
21+
22+
parseDateFromString :: String -> Day
23+
parseDateFromString filePath =
24+
let [year, month, day] = map read . take 3 . splitOn "-" $ filePath
25+
in fromGregorian (toInteger year) month day
26+
27+
data AlbumPostSummary = AlbumPostSummary {
28+
score :: Float,
29+
released :: Day,
30+
title :: String
31+
} deriving (Eq, Ord)
32+
33+
instance Show AlbumPostSummary where
34+
show summary =
35+
title summary ++ " (score: " ++ show (score summary) ++ ", release date: " ++ show (released summary) ++ ")"
36+
37+
getAlbumPostSummary :: String -> IO (Maybe AlbumPostSummary)
38+
getAlbumPostSummary filePath = do
39+
md <- T.pack <$> readFile ("posts/" ++ filePath)
40+
pandoc <- runIO $
41+
readMarkdown
42+
(def {
43+
readerStandalone = True,
44+
readerExtensions =
45+
enableExtension Ext_yaml_metadata_block (readerExtensions def) } )
46+
md
47+
case pandoc of
48+
Left _ -> return Nothing
49+
Right (Pandoc meta _) -> do
50+
if not . hasMusicTag $ lookupMetaInlines "tags" meta
51+
then do
52+
return Nothing
53+
else return $ Just AlbumPostSummary {
54+
released = parseDateFromString (getValue "released"),
55+
score = read (getValue "score") :: Float,
56+
title = getValue "title"
57+
}
58+
where
59+
hasMusicTag inlines = any (`elem` inlines) [Str "music", Str "music,"]
60+
getValue key = T.unpack . T.concat . map stringify . lookupMetaInlines key $ meta
61+
stringify (Str value) = value
62+
stringify Space = " "
63+
stringify _ = ""
64+
65+
data What = Good | Wack | Ok deriving (Eq)
66+
instance Show What where
67+
show Good = "====== good ======"
68+
show Wack = "====== wack ======"
69+
show Ok = "======= ok ======="
70+
71+
data Bucket = Bucket {
72+
summaries :: [AlbumPostSummary],
73+
what :: What
74+
}
75+
76+
77+
summariesToBuckets :: [AlbumPostSummary] -> ([AlbumPostSummary], [AlbumPostSummary], [AlbumPostSummary])
78+
summariesToBuckets = foldr f ([], [], [])
79+
where
80+
f s (hi, mid, lo) | score s >= 8.0 = (s:hi, mid, lo)
81+
f s (hi, mid, lo) | score s < 6.0 = (hi, mid, s:lo)
82+
f s (hi, mid, lo) = (hi, s:mid, lo)
83+
84+
printBucket :: Bucket -> IO ()
85+
printBucket bucket =
86+
if null (summaries bucket)
87+
then return ()
88+
else do
89+
putStrLn ""
90+
print (what bucket)
91+
mapM_ print $ summaries bucket
92+
putStrLn ""
93+
94+
main :: IO ()
95+
main = do
96+
files <- listDirectory "posts/"
97+
(year, month, _) <- toGregorian . utctDay <$> getCurrentTime
98+
let endDate = fromGregorian year month 1
99+
startDate = addGregorianMonthsClip (-1) endDate
100+
filteredFiles = filter ((\fileDate -> fileDate >= startDate && fileDate < endDate) . parseDateFromString) files
101+
allSummaries <- sortBy (comparing Down) . catMaybes <$> mapM getAlbumPostSummary filteredFiles
102+
let (hiScores, midScores, lowScores) = summariesToBuckets allSummaries
103+
mapM_ printBucket
104+
[ Bucket hiScores Good
105+
, Bucket midScores Ok
106+
, Bucket lowScores Wack
107+
]

‎scripts/monthly_rewind/hie.yaml‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
cradle:
2+
cabal:

‎scripts/monthly_rewind/monthly-rewind.cabal‎

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,81 @@
1+
cabal-version: 3.8
2+
3+
-- The cabal-version field refers to the version of the .cabal specification,
4+
-- and can be different from the cabal-install (the tool) version and the
5+
-- Cabal (the library) version you are using. As such, the Cabal (the library)
6+
-- version used must be equal or greater than the version stated in this field.
7+
-- Starting from the specification version 2.2, the cabal-version field must be
8+
-- the first thing in the cabal file.
9+
10+
-- Initial package description 'monthly-rewind' generated by
11+
-- 'cabal init'. For further documentation, see:
12+
-- http://haskell.org/cabal/users-guide/
13+
--
14+
-- The name of the package.
15+
name: monthly-rewind
16+
17+
-- The package version.
18+
-- See the Haskell package versioning policy (PVP) for standards
19+
-- guiding when and how versions should be incremented.
20+
-- https://pvp.haskell.org
21+
-- PVP summary: +-+------- breaking API changes
22+
-- | | +----- non-breaking API additions
23+
-- | | | +--- code changes with no API change
24+
version: 0.1.0.0
25+
26+
-- A short (one-line) description of the package.
27+
-- synopsis:
28+
29+
-- A longer description of the package.
30+
-- description:
31+
32+
-- The license under which the package is released.
33+
license:
34+
35+
-- The package author(s).
36+
author: Tsung-Ju Lii
37+
38+
-- An email address to which users can send suggestions, bug reports, and patches.
39+
maintainer: [email protected]
40+
41+
-- A copyright notice.
42+
-- copyright:
43+
build-type: Simple
44+
45+
-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.
46+
extra-doc-files: CHANGELOG.md
47+
48+
-- Extra source files to be distributed with the package, such as examples, or a tutorial module.
49+
-- extra-source-files:
50+
51+
common warnings
52+
ghc-options: -Wall
53+
54+
executable monthly-rewind
55+
-- Import common warning flags.
56+
import: warnings
57+
58+
-- .hs or .lhs file containing the Main module.
59+
main-is: Main.hs
60+
61+
-- Modules included in this executable, other than Main.
62+
-- other-modules:
63+
64+
-- LANGUAGE extensions used by modules in this package.
65+
-- other-extensions:
66+
67+
-- Other library packages from which modules are imported.
68+
build-depends:
69+
, base ^>=4.17.2.1
70+
, containers ==0.6.7
71+
, directory
72+
, pandoc ==3.0.1
73+
, text
74+
, time ==1.12.2
75+
, split
76+
77+
-- Directories containing source files.
78+
hs-source-dirs: app
79+
80+
-- Base language which the package is written in.
81+
default-language: Haskell2010

‎stack.yaml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,7 @@ resolver: lts-21.25
3535
packages:
3636
- .
3737
- scripts/pull_album_info
38+
- scripts/monthly_rewind
3839

3940
# Dependency packages to be pulled from upstream that are not in the resolver
4041
# using the same syntax as the packages field.

0 commit comments

Comments
 (0)