Skip to content

Commit 459195f

Browse files
usefulalgorithmusefulalgorithm
authored
feat: pull album info script (#68)
* feat: pull album info script Signed-off-by: Tsung-Ju Lii <[email protected]> * wip: output to stdout Signed-off-by: Tsung-Ju Lii <[email protected]> * done Signed-off-by: Tsung-Ju Lii <[email protected]> --------- Signed-off-by: Tsung-Ju Lii <[email protected]>
1 parent c086ea4 commit 459195f

File tree

6 files changed

+321
-0
lines changed

6 files changed

+321
-0
lines changed

‎.github/scripts/pull_album_info/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
dist-newstyle

‎.github/scripts/pull_album_info/app/Main.hs‎

Lines changed: 158 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,158 @@
1+
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
4+
{-# OPTIONS_GHC -Wno-name-shadowing #-}
5+
{-# LANGUAGE FlexibleInstances #-}
6+
{-# LANGUAGE MultiParamTypeClasses #-}
7+
8+
module Main where
9+
10+
-- Standard library imports
11+
import System.Environment (getArgs, getProgName, lookupEnv)
12+
13+
-- Third-party library imports
14+
import Control.Lens (Identity (runIdentity), (^?))
15+
import Data.Aeson (FromJSON (parseJSON), ToJSON,
16+
Value (Object), decodeStrict, (.:))
17+
import Data.Aeson.Lens (AsNumber (_Integer), key, nth)
18+
import Data.ByteString (ByteString)
19+
import qualified Data.ByteString.Char8 as BS
20+
import Data.List as L (intercalate)
21+
import Data.Text as T (unpack)
22+
import GHC.Generics (Generic)
23+
import Network.HTTP.Simple (Query, getResponseBody, httpBS,
24+
parseRequest_, setRequestHeader,
25+
setRequestQueryString)
26+
import System.FilePath (takeDirectory)
27+
import Text.Ginger (IncludeResolver, SourcePos, Template,
28+
ToGVal (..), dict, easyRender,
29+
parseGinger)
30+
import Control.Exception (try, SomeException)
31+
32+
-- Data type definitions
33+
data MainRelease = MainRelease {
34+
artists :: [String],
35+
title :: String,
36+
year :: Int,
37+
released :: String,
38+
imageUrl :: String,
39+
labels :: [String],
40+
uri :: String
41+
} deriving (Show, Eq, Generic)
42+
43+
instance ToJSON MainRelease
44+
45+
instance ToGVal m MainRelease where
46+
toGVal release = dict [
47+
("artists", toGVal . L.intercalate ", " . artists $ release),
48+
("title", toGVal $ title release),
49+
("year", toGVal $ year release),
50+
("released", toGVal $ released release),
51+
("imageUrl", toGVal $ imageUrl release),
52+
("labels", toGVal . L.intercalate ", " . labels $ release),
53+
("uri", toGVal $ uri release)
54+
]
55+
56+
57+
instance FromJSON MainRelease where
58+
parseJSON (Object v) = do
59+
artists <- v .: "artists" >>= traverse (.: "name")
60+
title <- v .: "title"
61+
year <- v .: "year"
62+
released <- v .: "released"
63+
images <- v .: "images"
64+
imageUrl <- case images of
65+
(img:_) -> img .: "resource_url"
66+
[] -> fail "No images found"
67+
labels <- v .: "labels" >>= traverse (.: "name")
68+
uri <- v .: "uri"
69+
return MainRelease {
70+
artists = artists,
71+
title = title,
72+
year = year,
73+
released = released,
74+
imageUrl = imageUrl,
75+
labels = labels,
76+
uri = uri
77+
}
78+
79+
-- Helper functions
80+
runDiscogsQuery :: Query -> String -> IO ByteString
81+
runDiscogsQuery query url = do
82+
maybeKey <- lookupEnv "DISCOG_KEY"
83+
maybeSecret <- lookupEnv "DISCOG_SECRET"
84+
(key, secret) <- case (maybeKey, maybeSecret) of
85+
(Just k, Just s) -> return (k, s)
86+
_ -> error "Environment variables DISCOG_KEY and/or DISCOG_SECRET are not set"
87+
let request =
88+
setRequestQueryString query $
89+
setRequestHeader "Authorization" [BS.pack $ "Discogs key=" ++ key ++ ", secret=" ++ secret] $
90+
setRequestHeader "User-Agent" ["pull-album-info/1.0 ([email protected])"] $
91+
parseRequest_ url
92+
getResponseBody <$> httpBS request
93+
94+
getMasterReleaseId :: String -> String -> IO String
95+
getMasterReleaseId artistName albumName = do
96+
let url = "https://api.discogs.com/database/search"
97+
query =
98+
[ ("artist", Just $ BS.pack artistName),
99+
("release_title", Just $ BS.pack albumName),
100+
("type", Just "master")
101+
]
102+
body <- BS.unpack <$> runDiscogsQuery query url
103+
case body ^? key "results" . nth 0 . key "master_id" . _Integer of
104+
Just masterId -> return $ show masterId
105+
Nothing -> fail "Failed to extract master_id from the response"
106+
107+
getMainReleaseId :: String -> IO String
108+
getMainReleaseId masterId = do
109+
let url = "https://api.discogs.com/masters/" ++ masterId
110+
body <- BS.unpack <$> runDiscogsQuery [] url
111+
case body ^? key "main_release" . _Integer of
112+
Just mainId -> return $ show mainId
113+
Nothing -> fail "Failed to extract main_release from the response"
114+
115+
getMainRelease :: String -> IO MainRelease
116+
getMainRelease releaseId = do
117+
let url = "https://api.discogs.com/releases/" ++ releaseId
118+
body <- runDiscogsQuery [] url
119+
case (decodeStrict body :: Maybe MainRelease) of
120+
Just release -> return release
121+
Nothing -> fail "Cannot decode main release"
122+
123+
nullResolver :: IncludeResolver Identity
124+
nullResolver = const $ return Nothing
125+
126+
getTemplate :: String -> Template SourcePos
127+
getTemplate content = either (error . show) id . runIdentity $
128+
parseGinger nullResolver Nothing content
129+
130+
templatePath :: IO String
131+
templatePath = do
132+
progName <- getProgName
133+
return $ takeDirectory progName ++ "/app/templates/post.md"
134+
135+
runGenAlbumPost :: String -> String -> IO String
136+
runGenAlbumPost artistName albumName = do
137+
-- Get the MainRelease of the album
138+
release <- getMasterReleaseId artistName albumName
139+
>>= getMainReleaseId
140+
>>= getMainRelease
141+
content <- templatePath >>= readFile
142+
return $ T.unpack . easyRender release $ getTemplate content
143+
144+
-- Main function
145+
main :: IO ()
146+
main = do
147+
args <- getArgs
148+
case args of
149+
[artistName, albumName, branchName] -> do
150+
result <- try $ runGenAlbumPost artistName albumName :: IO (Either SomeException String)
151+
post <- case result of
152+
Left _ -> do
153+
_ <- putStrLn "Cannot get album info from Discog, falling back to default post template"
154+
templatePath >>= readFile
155+
Right output -> return output
156+
writeFile branchName post
157+
putStrLn "done"
158+
_ -> putStrLn "Usage: pull_album_info <artist_name> <album_name> <branch_name>"

‎.github/scripts/pull_album_info/app/templates/post.md‎

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,22 @@
1+
---
2+
title: {{artists}} - {{title}}
3+
layout: post
4+
comments: false
5+
tags: {{year}}
6+
---
7+
8+
![{{imageUrl}}]({{imageUrl}})
9+
10+
<!--
11+
Write your post here!
12+
-->
13+
14+
---
15+
16+
Fav tracks:
17+
18+
Score: /10
19+
20+
Release date: {{released}}
21+
22+
Labels: {{labels}}

‎.github/scripts/pull_album_info/hie.yaml‎

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

‎.github/scripts/pull_album_info/pull-album-info.cabal‎

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

‎.github/workflows/create_album_post.yaml‎

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,57 @@
1+
name: Create Album Post
2+
description: Creates a PR to add a new album post to the blog.
3+
4+
on:
5+
workflow_dispatch:
6+
inputs:
7+
album_title:
8+
type: string
9+
required: true
10+
description: Title of the album.
11+
artist_name:
12+
type: string
13+
required: true
14+
description: Name of the artist.
15+
16+
jobs:
17+
create-branch-and-pr:
18+
runs-on: ubuntu-latest
19+
20+
steps:
21+
- name: Checkout repository
22+
uses: actions/checkout@v4
23+
24+
- name: Setup Haskell
25+
uses: haskell-actions/[email protected]
26+
with:
27+
cabal-version: 2.4
28+
ghc-version: 9.4.8
29+
30+
- name: Pull album info
31+
id: pull_album_info
32+
run: |
33+
BRANCH_NAME=$(echo "${{ github.event.inputs.album_title }}-${{ github.event.inputs.artist_name }}" | tr '[:upper:]' '[:lower:]' | tr -cd 'a-z0-9-')
34+
35+
# Build album template post
36+
cd .github/scripts/pull_album_info
37+
cabal build
38+
cabal run pull-album-info ${{ github.event.inputs.artist_name }} ${{ github.event.inputs.album_title }} $BRANCH_NAME
39+
mv $BRANCH_NAME ${{ github.workspace }}/drafts/$BRANCH_NAME
40+
41+
# Switch to bot account
42+
git config --global user.name 'github-actions[bot]'
43+
git config --global user.email 'github-actions[bot]@users.noreply.github.com'
44+
45+
# Set branch name to output
46+
echo "branch_name=$branch_name" >> $GITHUB_OUTPUT
47+
48+
- name: Create Pull Request
49+
id: create_pr
50+
uses: peter-evans/create-pull-request@v7
51+
with:
52+
token: ${{ secrets.GITHUB_TOKEN }}
53+
branch: ${{ steps.pull_album_info.outputs.branch_name }}
54+
base: main
55+
title: post/${{ steps.pull_album_info.outputs.branch_name }}
56+
body-path: '${{ github.workspace }}/drafts/${{ steps.pull_album_info.outputs.branch_name }}'
57+
labels: 'post'

0 commit comments

Comments
 (0)