From 93e90251537cfa061a31ba1e950d4c75d3c3484c Mon Sep 17 00:00:00 2001 From: Tsung-Ju Lii Date: Tue, 18 Mar 2025 18:50:39 +0800 Subject: [PATCH 1/3] feat: pull album info script Signed-off-by: Tsung-Ju Lii --- .github/scripts/pull_album_info/.gitignore | 1 + .github/scripts/pull_album_info/app/Main.hs | 102 ++++++++++++++++++ .github/scripts/pull_album_info/hie.yaml | 2 + .../pull_album_info/pull-album-info.cabal | 78 ++++++++++++++ 4 files changed, 183 insertions(+) create mode 100644 .github/scripts/pull_album_info/.gitignore create mode 100644 .github/scripts/pull_album_info/app/Main.hs create mode 100644 .github/scripts/pull_album_info/hie.yaml create mode 100644 .github/scripts/pull_album_info/pull-album-info.cabal diff --git a/.github/scripts/pull_album_info/.gitignore b/.github/scripts/pull_album_info/.gitignore new file mode 100644 index 0000000..4c61acd --- /dev/null +++ b/.github/scripts/pull_album_info/.gitignore @@ -0,0 +1 @@ +dist-newstyle \ No newline at end of file diff --git a/.github/scripts/pull_album_info/app/Main.hs b/.github/scripts/pull_album_info/app/Main.hs new file mode 100644 index 0000000..2e9b964 --- /dev/null +++ b/.github/scripts/pull_album_info/app/Main.hs @@ -0,0 +1,102 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +-- Standard library imports +import System.Environment (getArgs, lookupEnv) + +-- Third-party library imports +import Control.Lens ((^?)) +import Data.Aeson (FromJSON (parseJSON), ToJSON, + Value (Object), decodeStrict, encode, + (.:)) +import Data.Aeson.Lens (AsNumber (_Integer), key, nth) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import GHC.Generics (Generic) +import Network.HTTP.Simple (Query, getResponseBody, httpBS, + parseRequest_, setRequestHeader, + setRequestQueryString) + +-- Data type definitions +data MainRelease = MainRelease { + released :: String, + imageUrl :: String, + labels :: [String], + uri :: String +} deriving (Show, Eq, Generic) + +instance ToJSON MainRelease + +instance FromJSON MainRelease where + parseJSON (Object v) = do + uri <- v .: "uri" + released <- v .: "released" + images <- v .: "images" + imageUrl <- case images of + (img:_) -> img .: "resource_url" + [] -> fail "No images found" + labels <- v .: "labels" >>= traverse (.: "name") + return MainRelease { + uri = uri, + released = released, + imageUrl = imageUrl, + labels = labels + } + +-- Helper functions +runDiscogsQuery :: Query -> String -> IO ByteString +runDiscogsQuery query url = do + maybeKey <- lookupEnv "DISCOG_KEY" + maybeSecret <- lookupEnv "DISCOG_SECRET" + (key, secret) <- case (maybeKey, maybeSecret) of + (Just k, Just s) -> return (k, s) + _ -> error "Environment variables DISCOG_KEY and/or DISCOG_SECRET are not set" + let request = + setRequestQueryString query $ + setRequestHeader "Authorization" [BS.pack $ "Discogs key=" ++ key ++ ", secret=" ++ secret] $ + setRequestHeader "User-Agent" ["pull-album-info/1.0 (usefulalgorithm@gmail.com)"] $ + parseRequest_ url + getResponseBody <$> httpBS request + +getMasterReleaseId :: String -> String -> IO String +getMasterReleaseId artistName albumName = do + let url = "https://api.discogs.com/database/search" + query = + [ ("artist", Just $ BS.pack artistName), + ("release_title", Just $ BS.pack albumName), + ("type", Just "master") + ] + body <- BS.unpack <$> runDiscogsQuery query url + case body ^? key "results" . nth 0 . key "master_id" . _Integer of + Just masterId -> return $ show masterId + Nothing -> fail "Failed to extract master_id from the response" + +getMainReleaseId :: String -> IO String +getMainReleaseId masterId = do + let url = "https://api.discogs.com/masters/" ++ masterId + body <- BS.unpack <$> runDiscogsQuery [] url + case body ^? key "main_release" . _Integer of + Just mainId -> return $ show mainId + Nothing -> fail "Failed to extract main_release from the response" + +getMainRelease :: String -> IO MainRelease +getMainRelease releaseId = do + let url = "https://api.discogs.com/releases/" ++ releaseId + body <- runDiscogsQuery [] url + case (decodeStrict body :: Maybe MainRelease) of + Just release -> return release + Nothing -> fail "Cannot decode main release" + +-- Main function +main :: IO () +main = do + args <- getArgs + case args of + [artistName, albumName] -> do + release <- getMasterReleaseId artistName albumName + >>= getMainReleaseId + >>= getMainRelease + putStrLn $ BS.unpack $ BS.toStrict $ encode release + _ -> putStrLn "Usage: pull_album_info " diff --git a/.github/scripts/pull_album_info/hie.yaml b/.github/scripts/pull_album_info/hie.yaml new file mode 100644 index 0000000..f0c7014 --- /dev/null +++ b/.github/scripts/pull_album_info/hie.yaml @@ -0,0 +1,2 @@ +cradle: + cabal: \ No newline at end of file diff --git a/.github/scripts/pull_album_info/pull-album-info.cabal b/.github/scripts/pull_album_info/pull-album-info.cabal new file mode 100644 index 0000000..5caa1d2 --- /dev/null +++ b/.github/scripts/pull_album_info/pull-album-info.cabal @@ -0,0 +1,78 @@ +cabal-version: >= 2.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'pull-album-info' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: pull-album-info + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: NONE + +-- The package author(s). +author: Tsung-Ju Lii + +-- An email address to which users can send suggestions, bug reports, and patches. +maintainer: usefulalgorithm@gmail.com + +-- A copyright notice. +-- copyright: +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +executable pull-album-info + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base ^>=4.17.2.1, + http-conduit, + aeson, + bytestring, + lens-aeson, + lens + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: Haskell2010 From 113e246c3f9d3b2e7db20b45e8c2244c669cfee1 Mon Sep 17 00:00:00 2001 From: Tsung-Ju Lii Date: Wed, 19 Mar 2025 14:41:18 +0800 Subject: [PATCH 2/3] wip: output to stdout Signed-off-by: Tsung-Ju Lii --- .github/scripts/pull_album_info/app/Main.hs | 59 ++++++++++++++++--- .../pull_album_info/app/templates/post.md | 24 ++++++++ .../pull_album_info/pull-album-info.cabal | 7 ++- 3 files changed, 81 insertions(+), 9 deletions(-) create mode 100644 .github/scripts/pull_album_info/app/templates/post.md diff --git a/.github/scripts/pull_album_info/app/Main.hs b/.github/scripts/pull_album_info/app/Main.hs index 2e9b964..c27cdef 100644 --- a/.github/scripts/pull_album_info/app/Main.hs +++ b/.github/scripts/pull_album_info/app/Main.hs @@ -1,26 +1,39 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Main where -- Standard library imports -import System.Environment (getArgs, lookupEnv) +import System.Environment (getArgs, getProgName, lookupEnv) -- Third-party library imports -import Control.Lens ((^?)) +import Control.Lens (Identity (runIdentity), (^?)) import Data.Aeson (FromJSON (parseJSON), ToJSON, Value (Object), decodeStrict, encode, (.:)) import Data.Aeson.Lens (AsNumber (_Integer), key, nth) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS +import Data.List as L (intercalate) +import Data.Text as T (unpack) import GHC.Generics (Generic) import Network.HTTP.Simple (Query, getResponseBody, httpBS, parseRequest_, setRequestHeader, setRequestQueryString) +import System.FilePath (takeDirectory) +import Text.Ginger (IncludeResolver, SourcePos, Template, + ToGVal (..), dict, easyRender, + parseGinger) -- Data type definitions data MainRelease = MainRelease { + artists :: [String], + title :: String, + year :: Int, released :: String, imageUrl :: String, labels :: [String], @@ -29,20 +42,38 @@ data MainRelease = MainRelease { instance ToJSON MainRelease +instance ToGVal m MainRelease where + toGVal release = dict [ + ("artists", toGVal . L.intercalate ", " . artists $ release), + ("title", toGVal $ title release), + ("year", toGVal $ year release), + ("released", toGVal $ released release), + ("imageUrl", toGVal $ imageUrl release), + ("labels", toGVal . L.intercalate ", " . labels $ release), + ("uri", toGVal $ uri release) + ] + + instance FromJSON MainRelease where parseJSON (Object v) = do - uri <- v .: "uri" + artists <- v .: "artists" >>= traverse (.: "name") + title <- v .: "title" + year <- v .: "year" released <- v .: "released" images <- v .: "images" imageUrl <- case images of (img:_) -> img .: "resource_url" [] -> fail "No images found" labels <- v .: "labels" >>= traverse (.: "name") + uri <- v .: "uri" return MainRelease { - uri = uri, + artists = artists, + title = title, + year = year, released = released, imageUrl = imageUrl, - labels = labels + labels = labels, + uri = uri } -- Helper functions @@ -89,6 +120,16 @@ getMainRelease releaseId = do Just release -> return release Nothing -> fail "Cannot decode main release" +nullResolver :: IncludeResolver Identity +nullResolver = const $ return Nothing + +-- | This is our template. Because 'parseGinger' wants a monad (as loading +-- includes would normally go through some sort of monadic API like 'IO'), we +-- use 'Identity' here. +getTemplate :: String -> Template SourcePos +getTemplate content = either (error . show) id . runIdentity $ + parseGinger nullResolver Nothing content + -- Main function main :: IO () main = do @@ -99,4 +140,8 @@ main = do >>= getMainReleaseId >>= getMainRelease putStrLn $ BS.unpack $ BS.toStrict $ encode release + content <- getProgName >>= readFile . (++ "/app/templates/post.md") . takeDirectory + let template = getTemplate content + let output = T.unpack $ easyRender release template + putStrLn output _ -> putStrLn "Usage: pull_album_info " diff --git a/.github/scripts/pull_album_info/app/templates/post.md b/.github/scripts/pull_album_info/app/templates/post.md new file mode 100644 index 0000000..f243252 --- /dev/null +++ b/.github/scripts/pull_album_info/app/templates/post.md @@ -0,0 +1,24 @@ +--- +title: {{artists}} - {{title}} +layout: post +comments: false +tags: {{year}} +--- + +![{{imageUrl}}]({{imageUrl}}) + + + +--- + +Fav tracks: + +Score: /10 + +Released: {{released}} + +Labels: {{labels}} + +Bandcamp: []() diff --git a/.github/scripts/pull_album_info/pull-album-info.cabal b/.github/scripts/pull_album_info/pull-album-info.cabal index 5caa1d2..d192d26 100644 --- a/.github/scripts/pull_album_info/pull-album-info.cabal +++ b/.github/scripts/pull_album_info/pull-album-info.cabal @@ -1,4 +1,4 @@ -cabal-version: >= 2.0 +cabal-version: 2.4 -- The cabal-version field refers to the version of the .cabal specification, -- and can be different from the cabal-install (the tool) version and the -- Cabal (the library) version you are using. As such, the Cabal (the library) @@ -69,7 +69,10 @@ executable pull-album-info aeson, bytestring, lens-aeson, - lens + lens, + ginger, + text, + filepath -- Directories containing source files. hs-source-dirs: app From 53ae695ebb28c466a3f635d9a63647c3fb4322cb Mon Sep 17 00:00:00 2001 From: Tsung-Ju Lii Date: Wed, 19 Mar 2025 18:42:25 +0800 Subject: [PATCH 3/3] done Signed-off-by: Tsung-Ju Lii --- .github/scripts/pull_album_info/app/Main.hs | 41 ++++++++----- .../pull_album_info/app/templates/post.md | 6 +- .github/workflows/create_album_post.yaml | 57 +++++++++++++++++++ 3 files changed, 85 insertions(+), 19 deletions(-) create mode 100644 .github/workflows/create_album_post.yaml diff --git a/.github/scripts/pull_album_info/app/Main.hs b/.github/scripts/pull_album_info/app/Main.hs index c27cdef..f23024e 100644 --- a/.github/scripts/pull_album_info/app/Main.hs +++ b/.github/scripts/pull_album_info/app/Main.hs @@ -13,8 +13,7 @@ import System.Environment (getArgs, getProgName, lookupEnv) -- Third-party library imports import Control.Lens (Identity (runIdentity), (^?)) import Data.Aeson (FromJSON (parseJSON), ToJSON, - Value (Object), decodeStrict, encode, - (.:)) + Value (Object), decodeStrict, (.:)) import Data.Aeson.Lens (AsNumber (_Integer), key, nth) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS @@ -28,6 +27,7 @@ import System.FilePath (takeDirectory) import Text.Ginger (IncludeResolver, SourcePos, Template, ToGVal (..), dict, easyRender, parseGinger) +import Control.Exception (try, SomeException) -- Data type definitions data MainRelease = MainRelease { @@ -123,25 +123,36 @@ getMainRelease releaseId = do nullResolver :: IncludeResolver Identity nullResolver = const $ return Nothing --- | This is our template. Because 'parseGinger' wants a monad (as loading --- includes would normally go through some sort of monadic API like 'IO'), we --- use 'Identity' here. getTemplate :: String -> Template SourcePos getTemplate content = either (error . show) id . runIdentity $ parseGinger nullResolver Nothing content +templatePath :: IO String +templatePath = do + progName <- getProgName + return $ takeDirectory progName ++ "/app/templates/post.md" + +runGenAlbumPost :: String -> String -> IO String +runGenAlbumPost artistName albumName = do + -- Get the MainRelease of the album + release <- getMasterReleaseId artistName albumName + >>= getMainReleaseId + >>= getMainRelease + content <- templatePath >>= readFile + return $ T.unpack . easyRender release $ getTemplate content + -- Main function main :: IO () main = do args <- getArgs case args of - [artistName, albumName] -> do - release <- getMasterReleaseId artistName albumName - >>= getMainReleaseId - >>= getMainRelease - putStrLn $ BS.unpack $ BS.toStrict $ encode release - content <- getProgName >>= readFile . (++ "/app/templates/post.md") . takeDirectory - let template = getTemplate content - let output = T.unpack $ easyRender release template - putStrLn output - _ -> putStrLn "Usage: pull_album_info " + [artistName, albumName, branchName] -> do + result <- try $ runGenAlbumPost artistName albumName :: IO (Either SomeException String) + post <- case result of + Left _ -> do + _ <- putStrLn "Cannot get album info from Discog, falling back to default post template" + templatePath >>= readFile + Right output -> return output + writeFile branchName post + putStrLn "done" + _ -> putStrLn "Usage: pull_album_info " diff --git a/.github/scripts/pull_album_info/app/templates/post.md b/.github/scripts/pull_album_info/app/templates/post.md index f243252..73d0e26 100644 --- a/.github/scripts/pull_album_info/app/templates/post.md +++ b/.github/scripts/pull_album_info/app/templates/post.md @@ -8,7 +8,7 @@ tags: {{year}} ![{{imageUrl}}]({{imageUrl}}) --- @@ -17,8 +17,6 @@ Fav tracks: Score: /10 -Released: {{released}} +Release date: {{released}} Labels: {{labels}} - -Bandcamp: []() diff --git a/.github/workflows/create_album_post.yaml b/.github/workflows/create_album_post.yaml new file mode 100644 index 0000000..502f58e --- /dev/null +++ b/.github/workflows/create_album_post.yaml @@ -0,0 +1,57 @@ +name: Create Album Post +description: Creates a PR to add a new album post to the blog. + +on: + workflow_dispatch: + inputs: + album_title: + type: string + required: true + description: Title of the album. + artist_name: + type: string + required: true + description: Name of the artist. + +jobs: + create-branch-and-pr: + runs-on: ubuntu-latest + + steps: + - name: Checkout repository + uses: actions/checkout@v4 + + - name: Setup Haskell + uses: haskell-actions/setup@v2.7.10 + with: + cabal-version: 2.4 + ghc-version: 9.4.8 + + - name: Pull album info + id: pull_album_info + run: | + BRANCH_NAME=$(echo "${{ github.event.inputs.album_title }}-${{ github.event.inputs.artist_name }}" | tr '[:upper:]' '[:lower:]' | tr -cd 'a-z0-9-') + + # Build album template post + cd .github/scripts/pull_album_info + cabal build + cabal run pull-album-info ${{ github.event.inputs.artist_name }} ${{ github.event.inputs.album_title }} $BRANCH_NAME + mv $BRANCH_NAME ${{ github.workspace }}/drafts/$BRANCH_NAME + + # Switch to bot account + git config --global user.name 'github-actions[bot]' + git config --global user.email 'github-actions[bot]@users.noreply.github.com' + + # Set branch name to output + echo "branch_name=$branch_name" >> $GITHUB_OUTPUT + + - name: Create Pull Request + id: create_pr + uses: peter-evans/create-pull-request@v7 + with: + token: ${{ secrets.GITHUB_TOKEN }} + branch: ${{ steps.pull_album_info.outputs.branch_name }} + base: main + title: post/${{ steps.pull_album_info.outputs.branch_name }} + body-path: '${{ github.workspace }}/drafts/${{ steps.pull_album_info.outputs.branch_name }}' + labels: 'post'