From c72953df05259b20a7fc87117aefbbe284a376a1 Mon Sep 17 00:00:00 2001 From: Carlos Sosa Date: Sat, 18 Apr 2020 20:08:00 -0700 Subject: Initial commit v0.1.0 --- src/Sound/MusicDirTrans/File.hs | 70 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100755 src/Sound/MusicDirTrans/File.hs (limited to 'src/Sound/MusicDirTrans/File.hs') diff --git a/src/Sound/MusicDirTrans/File.hs b/src/Sound/MusicDirTrans/File.hs new file mode 100755 index 0000000..e319b80 --- /dev/null +++ b/src/Sound/MusicDirTrans/File.hs @@ -0,0 +1,70 @@ +module Sound.MusicDirTrans.File + ( getMetadata + , trackFilePatterns + , mkArtistPath + ) +where + +import Control.Monad +import Control.Monad.IO.Class +import Data.List as L +import Data.Monoid +import Data.Ord +import Sound.HTagLib +import Sound.MusicDirTrans.Type +import System.Directory +import System.FilePath.Glob +import Data.Text as T + +metadataGetter :: TagGetter Metadata +metadataGetter = Metadata <$> artistGetter <*> albumGetter <*> yearGetter + +getMetadata :: MonadIO m => FilePath -> m Metadata +getMetadata path = getTags path metadataGetter + +trackFileExt :: [String] +trackFileExt = + [ "*.flac" + , "*.wav" + , "*.mp3" + , "*.mp4" + , "*.asf" + , "*.aiff" + , "*.mpc" + , "*.spx" + , "*.tt" + , "*.wv" + ] + +trackFilePatterns :: [Pattern] +trackFilePatterns = L.map compile trackFileExt + +mostCommon :: Ord c => (a -> c) -> [a] -> c +mostCommon e metadata = + L.head . maximumBy (comparing L.length) . L.group . sort $ L.map + e + metadata + +mostCommonArtist :: [Metadata] -> T.Text +mostCommonArtist = mostCommon (unArtist . mArtist) + +mostCommonAlbum :: [Metadata] -> T.Text +mostCommonAlbum = mostCommon (unAlbum . mAlbum) + +mostCommonYear :: [Metadata] -> Maybe Int +mostCommonYear = mostCommon (fmap unYear . mYear) + +mkArtistPath :: FilePath -> [Metadata] -> ArtistPath +mkArtistPath path metadata = ArtistPath path parentPath childPath + where + parentPath = unpack $ mostCommonArtist metadata + album = mostCommonAlbum metadata + year = mostCommonYear metadata + childPath = unpack $ mkNewPathName album year + +mkNewPathName :: Text -> Maybe Int -> Text +mkNewPathName album year = append album year' + where + year' = case year of + Nothing -> pack "" + Just y -> pack $ " (" ++ show y ++ ")" -- cgit v1.3-2-g0d8e