103 lines
4.0 KiB
Haskell
103 lines
4.0 KiB
Haskell
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 = 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)
|