Rewrite 7digital in haskell

7digital/Main.hs

@@ -1,9 +1,102 @@
-import Control.Monad (void)
+module Main
-import System.Process (rawSystem)
+    ( 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
+main = getArgs >>= withArguments 
-    arguments <- getArgs
+  where
-    void $ rawSystem "bundle"
+    withArguments [sourceArchive, musicDirectory]
-        $ "exec" : "./bin/7digital.rb" : arguments
+        = 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)

Gemfile

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

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

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
+according to the meta information saved in the audio files. The audo file format
-expected to be in 2 directories, the artist and album directories. These
+is "{2-digit track number} - {song title}.{extension}". Each file is put into
-directories are also renamed.
+a subdirectory named after the album.
 
 ## cross\_toolchain.rb
 

bin/7digital.rb

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

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