From a7fca1c9fa5500e1faf526f961eb190415261b14 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Tue, 20 Jan 2026 19:13:31 +0100 Subject: [PATCH] Rewrite 7digital in haskell --- 7digital/Main.hs | 105 ++++++++++++++++++++++++++++++++++++++++++++--- Gemfile | 1 - Gemfile.lock | 2 - README.md | 12 +++--- bin/7digital.rb | 104 ---------------------------------------------- kazbek.cabal | 6 ++- 6 files changed, 109 insertions(+), 121 deletions(-) delete mode 100755 bin/7digital.rb diff --git a/7digital/Main.hs b/7digital/Main.hs index 26cdeb3..9f1800e 100644 --- a/7digital/Main.hs +++ b/7digital/Main.hs @@ -1,9 +1,102 @@ -import Control.Monad (void) -import System.Process (rawSystem) +module Main + ( main + ) where + +import Codec.Archive.Zip + ( saveEntry + , unEntrySelector + , forEntries + , withArchive + , getEntryName + ) +import Data.Text (StrictText) +import qualified Data.Text as StrictText +import qualified Data.Text.IO as StrictText +import System.Directory (createDirectoryIfMissing, listDirectory, renameFile) +import System.Process (readProcessWithExitCode) import System.Environment (getArgs) +import System.IO (hPutStrLn, stderr) +import System.FilePath ((<.>), (), takeFileName, takeExtension) +import System.Exit (ExitCode(..), exitWith) +import Control.Monad (foldM, when) +import Control.Monad.IO.Class (MonadIO(..)) +import Data.List (find) +import Data.Bifunctor (Bifunctor(..)) +import Data.Map (Map) +import qualified Data.Map as Map main :: IO () -main = do - arguments <- getArgs - void $ rawSystem "bundle" - $ "exec" : "./bin/7digital.rb" : arguments +main = getArgs >>= withArguments + where + withArguments [sourceArchive, musicDirectory] + = createDirectoryIfMissing True musicDirectory + >> extract sourceArchive musicDirectory + >> probeDirectory musicDirectory + >>= withMetadata musicDirectory + withArguments _ = hPutStrLn stderr "Usage: 7digital MUSIC_ARCHIVE.zip DIRECTORY" + >> exitWith (ExitFailure 1) + withMetadata musicDirectory (metadata, anyErrors) + = Map.traverseWithKey (renameSong musicDirectory) metadata + >> when anyErrors (exitWith (ExitFailure 2)) + +data Song = Song + { album :: StrictText + , title :: StrictText + , track :: StrictText + } deriving (Eq, Show) + +renameSong :: FilePath -> FilePath -> Song -> IO () +renameSong musicDirectory songPath Song{..} = + let newFileName = StrictText.unpack (paddedTrack <> " - " <> title) + <.> takeExtension songPath + newDirectory = musicDirectory StrictText.unpack album + in createDirectoryIfMissing False newDirectory + >> renameFile songPath (newDirectory newFileName) + >> putStrLn ("\"" <> newFileName <> "\"" <> " renamed.") + where + paddedTrack + | StrictText.length track <= 1 = "0" <> track + | otherwise = track + +probeDirectory :: FilePath -> IO (Map FilePath Song, Bool) +probeDirectory musicDirectory = + listDirectory musicDirectory >>= foldM probeEach (Map.empty, False) + where + probeEach (metadata, _) "MissingFiles.txt" + = StrictText.readFile (musicDirectory "MissingFiles.txt") + >>= StrictText.hPutStr stderr + >> pure (metadata, True) + probeEach metadata songFile = + let metadataKey = musicDirectory songFile + in readProcessWithExitCode "ffprobe" [metadataKey] "" + >>= handleProbeResult metadata metadataKey . parseProbe + handleProbeResult (metadata, anyErrors) metadataKey (Right songProbe) = + pure (Map.insert metadataKey songProbe metadata, anyErrors) + handleProbeResult (metadata, _) metadataKey (Left missingField) = + let message = "Metadata \"" <> missingField + <> "\" is not available for " <> StrictText.pack metadataKey + <> "." + in StrictText.hPutStrLn stderr message >> pure (metadata, True) + parseProbe (_, _, probeOutput) = createSong + $ filter fieldFilter + $ bimap normalizeName stripValue . StrictText.breakOn ":" + <$> StrictText.lines (StrictText.pack probeOutput) + fieldFilter (name, _) = name `elem` ["title", "album", "track"] + createSong songFields = Song + <$> findByField "album" songFields + <*> findByField "title" songFields + <*> findByField "track" songFields + findByField needle songFields + | Just found <- find ((== needle) . fst) songFields = Right $ snd found + | otherwise = Left needle + normalizeName = StrictText.toLower . StrictText.strip + stripValue = StrictText.strip . StrictText.drop 1 + +extract :: MonadIO m => FilePath -> FilePath -> m () +extract sourceArchive musicDirectory = do + withArchive sourceArchive (forEntries forSong) + where + forSong selector = + let entryName = takeFileName (unEntrySelector selector) + in liftIO (StrictText.putStrLn $ "Inflating " <> getEntryName selector) + >> saveEntry selector (musicDirectory entryName) diff --git a/Gemfile b/Gemfile index ef8fd67..3222d90 100644 --- a/Gemfile +++ b/Gemfile @@ -3,5 +3,4 @@ source 'https://rubygems.org' gem 'pg', '~> 1.6' -gem 'rubyzip', '~> 3.2' gem 'term-ansicolor', '~> 1.11' diff --git a/Gemfile.lock b/Gemfile.lock index 2fdffc2..2695211 100644 --- a/Gemfile.lock +++ b/Gemfile.lock @@ -10,7 +10,6 @@ GEM reline reline (0.6.3) io-console (~> 0.5) - rubyzip (3.2.2) sync (0.5.0) term-ansicolor (1.11.3) tins (~> 1) @@ -26,7 +25,6 @@ PLATFORMS DEPENDENCIES pg (~> 1.6) - rubyzip (~> 3.2) term-ansicolor (~> 1.11) BUNDLED WITH diff --git a/README.md b/README.md index 4ec1498..5a86041 100644 --- a/README.md +++ b/README.md @@ -8,22 +8,22 @@ The repository contains a collection of random scripts and short programs. # Contents -1. [7digital.rb](#7digitalrb) +1. [7digital](#7digital) 2. [cross\_toolchain.rb](#cross_toolchainrb) 3. [rename.rb](#renamerb) 4. [pg\_jekyll.rb](#pg_jekyllrb) 5. [locopy](#locopy) 6. [tea-cleaner](#tea-cleaner) -## 7digital.rb +## 7digital 7digital sells digital music but they can't handle files with non-English names. -`bin/7digital.rb` takes 2 arguments, a zip archive with audio files and a target +`7digital` takes 2 arguments, a zip archive with audio files and a target directory. It extracts the archive into the directory and renames its contents -according to the meta information saved in the audio files. The audio files are -expected to be in 2 directories, the artist and album directories. These -directories are also renamed. +according to the meta information saved in the audio files. The audo file format +is "{2-digit track number} - {song title}.{extension}". Each file is put into +a subdirectory named after the album. ## cross\_toolchain.rb diff --git a/bin/7digital.rb b/bin/7digital.rb deleted file mode 100755 index 0fb894e..0000000 --- a/bin/7digital.rb +++ /dev/null @@ -1,104 +0,0 @@ -#!/usr/bin/env ruby -# This Source Code Form is subject to the terms of the Mozilla Public License, -# v. 2.0. If a copy of the MPL was not distributed with this file, You can -# obtain one at https://mozilla.org/MPL/2.0/. - -# frozen_string_literal: true - -require 'pathname' -require 'open3' -require 'zip' - -# Renames music files in a directory according to the file's tags. -# Expects two arguments: -# - Path to the zip file with music files. -# - Music directory to extract songs into. - -class Song - attr_reader :track, :extension - attr_accessor :title, :album - - def initialize(extension) - @extension = extension - end - - def track=(track) - @track = track.strip.split('/').first.rjust(2, '0') - end - - def to_s - @track + ' - ' + @title + @extension - end -end - -def find_unnamed_directory(parent_path) - parent_path.children.filter { |child| child.basename.to_s.start_with? '_' }.first -end - -def extract_and_rename_archive(album_archive, music_directory) - music_directory.mkpath - - Zip::File.open album_archive.to_path do |zip_file| - zip_file.each do |entry| - puts "Inflating #{entry.name}" - extract_target = music_directory + File.basename(entry.name) - - entry.extract extract_target - end - end - - music_directory -end - -def probe_song(song_path) - song = Song.new song_path.extname - - Open3.popen3 'ffprobe', song_path.to_s do |_stdin, _stdout, stderr, _wait_pid| - while (line = stderr.gets) - key, value = line.split ':', 2 - next if value.nil? - - case key.strip.downcase - when 'title' - song.title = value.strip if song.title.nil? - when 'track' - song.track = value if song.track.nil? - when 'album' - song.album = value.strip if song.album.nil? - end - end - end - song -end - -unless ARGV.length == 2 - $stderr.puts 'Usage: 7digital.rb MUSIC_ARCHIVE.zip DIRECTORY' - exit 1 -end - -exit_code = 0 -album_archive = Pathname.new ARGV[0] -music_directory = Pathname.new ARGV[1] -metadata = {} - -extract_and_rename_archive album_archive, music_directory - -Dir.each_child music_directory do |filename| - song_path = music_directory + filename - - if filename == 'MissingFiles.txt' - IO.copy_stream File.open(song_path, 'r'), $stderr - exit_code = 2 - else - metadata[song_path] = probe_song(song_path) - end -end - -metadata.each_pair do |from, to| - album_path = music_directory + to.album - - album_path.mkpath - File.rename(from, album_path + to.to_s) -end - -exit exit_code diff --git a/kazbek.cabal b/kazbek.cabal index 1615733..08c5a48 100644 --- a/kazbek.cabal +++ b/kazbek.cabal @@ -22,6 +22,8 @@ common warnings aeson ^>= 2.2.3, base >= 4.20 && < 5, bytestring ^>= 0.12.2, + directory ^>= 1.3.9, + filepath ^>= 1.5.4, process ^>= 1.6.26, text ^>= 2.1 @@ -50,8 +52,6 @@ executable locopy Locopy.CommandLine Locopy.Wordpress build-depends: - directory ^>= 1.3.9, - filepath ^>= 1.5.4, optparse-applicative ^>= 0.19 executable 7digital @@ -59,3 +59,5 @@ executable 7digital main-is: Main.hs hs-source-dirs: 7digital build-depends: + containers >= 0.7 && < 0.9, + zip ^>= 2.2