feat: pull album info script

.github/scripts/pull_album_info/.gitignore

@@ -0,0 +1 @@
+dist-newstyle

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

@@ -0,0 +1,158 @@
+{-# 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, getProgName, lookupEnv)
+
+-- Third-party library imports
+import           Control.Lens          (Identity (runIdentity), (^?))
+import           Data.Aeson            (FromJSON (parseJSON), ToJSON,
+                                        Value (Object), decodeStrict, (.:))
+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)
+import Control.Exception (try, SomeException)
+
+-- Data type definitions
+data MainRelease = MainRelease {
+  artists  :: [String],
+  title    :: String,
+  year     :: Int,
+  released :: String,
+  imageUrl :: String,
+  labels   :: [String],
+  uri      :: String
+} deriving (Show, Eq, Generic)
+
+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
+    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 {
+      artists = artists,
+      title = title,
+      year = year,
+      released = released,
+      imageUrl = imageUrl,
+      labels = labels,
+      uri = uri
+    }
+
+-- 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 ([email protected])"] $
+        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"
+
+nullResolver :: IncludeResolver Identity
+nullResolver = const $ return Nothing
+
+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, 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 <artist_name> <album_name> <branch_name>"

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

@@ -0,0 +1,22 @@
+---
+title: {{artists}} - {{title}}
+layout: post
+comments: false
+tags: {{year}}
+---
+
+![{{imageUrl}}]({{imageUrl}})
+
+<!--
+Write your post here!
+-->
+
+---
+
+Fav tracks:
+
+Score: /10
+
+Release date: {{released}}
+
+Labels: {{labels}}

.github/scripts/pull_album_info/hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  cabal:

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

@@ -0,0 +1,81 @@
+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)
+-- 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:         [email protected]
+
+-- 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,
+                      ginger,
+                      text,
+                      filepath
+
+    -- Directories containing source files.
+    hs-source-dirs:   app
+
+    -- Base language which the package is written in.
+    default-language: Haskell2010

.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/[email protected]
+        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'