1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
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)
|
