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..f23024e --- /dev/null +++ b/.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 (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" + +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 " 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..73d0e26 --- /dev/null +++ b/.github/scripts/pull_album_info/app/templates/post.md @@ -0,0 +1,22 @@ +--- +title: {{artists}} - {{title}} +layout: post +comments: false +tags: {{year}} +--- + +![{{imageUrl}}]({{imageUrl}}) + + + +--- + +Fav tracks: + +Score: /10 + +Release date: {{released}} + +Labels: {{labels}} 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..d192d26 --- /dev/null +++ b/.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: 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, + ginger, + text, + filepath + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: Haskell2010 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'