belka/kazbek
1
0
Fork 0
Code Activity

Rewrite 7digital in haskell

Browse Source
This commit is contained in:
Eugen Wissner
2026-01-20 19:13:31 +01:00
parent 3c313315c9
commit a7fca1c9fa
6 changed files with 109 additions and 121 deletions
Download Patch File Download Diff File Expand all files Collapse all files

105
7digital/Main.hs
View File

@@ -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)

1
Gemfile
View File

@@ -3,5 +3,4 @@
source 'https://rubygems.org'
gem 'pg', '~> 1.6'
gem 'rubyzip', '~> 3.2'
gem 'term-ansicolor', '~> 1.11'

2
Gemfile.lock
View File

@@ -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

12
README.md
View File

@@ -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

104
bin/7digital.rb
View File

@@ -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

6
kazbek.cabal
View File

@@ -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