Initial commit v0.1.0HEADmaster

3 files changed, 168 insertions, 0 deletions

diff --git a/src/Sound/MusicDirTrans/Directory.hs b/src/Sound/MusicDirTrans/Directory.hs
new file mode 100755
index 0000000..0cc1b8f
--- /dev/null
+++ b/src/Sound/MusicDirTrans/Directory.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE OverloadedStrings  #-}
+module Sound.MusicDirTrans.Directory
+        ( copyToNewPath
+        , getTracksInDir
+        , genArtistPathFromTracks
+        , mkNewDirs
+        , mkRevertFile
+        , mkRevertArtistPath
+        , revertFile
+        )
+where
+import           Data.Monoid
+import           Data.List
+import           Data.Text                      ( Text
+                                                , append
+                                                , pack
+                                                )
+import           Control.Monad.IO.Class
+import           Distribution.Simple.Utils
+import           Distribution.Verbosity
+import           Sound.MusicDirTrans.File
+import           Sound.MusicDirTrans.Type
+import           Sound.HTagLib
+import           System.Directory
+import           System.FilePath.Glob
+import           System.FilePath.Posix
+
+
+
+revertFile :: FilePath
+revertFile = "dir.orig.name.txt"
+
+getTracksInDir :: FilePath -> IO [AudioTrack]
+getTracksInDir path =
+        map AudioTrack <$> (concat <$> globDir trackFilePatterns path)
+
+mkNewDirs :: ArtistPath -> IO ()
+mkNewDirs (ArtistPath _ p c) =
+        createDirectoryIfMissing False p
+                >> createDirectoryIfMissing False (p ++ "/" ++ c)
+
+genArtistPathFromTracks :: FilePath -> IO ArtistPath
+genArtistPathFromTracks path = do
+        ats      <- getTracksInDir path
+        metadata <- mapM (getMetadata . currentPath) ats
+        return $ mkArtistPath path metadata
+
+copyToNewPath :: ArtistPath -> IO ()
+copyToNewPath ap = copyDirectoryRecursive verbosity (rootPath ap) (newPath ap)
+        where verbosity = normal
+
+mkRevertFile :: ArtistPath -> IO ()
+mkRevertFile ap = writeFile filePath fileContent
+    where
+        filePath    = newPath ap ++ revertFile
+        fileContent = last $ splitDirectories $ rootPath ap
+
+mkRevertArtistPath :: FilePath -> FilePath -> ArtistPath
+mkRevertArtistPath p op = ArtistPath p "" rp
+    where
+        rrp = intercalate "/" . init $ splitDirectories p
+        rp  = rrp ++ "/" ++ op
+
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 ++ ")"
diff --git a/src/Sound/MusicDirTrans/Type.hs b/src/Sound/MusicDirTrans/Type.hs
new file mode 100755
index 0000000..463cd96
--- /dev/null
+++ b/src/Sound/MusicDirTrans/Type.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE OverloadedStrings  #-}
+module Sound.MusicDirTrans.Type
+        ( AudioTrack(..)
+        , Metadata(..)
+        , ArtistPath(..)
+        , newPath
+        )
+where
+
+
+import           Sound.HTagLib                  ( Artist
+                                                , Album
+                                                , Year
+                                                , FileType
+                                                )
+
+data AudioTrack = AudioTrack
+  { currentPath :: FilePath }
+  deriving (Show, Eq)
+
+data Metadata = Metadata
+  { mArtist :: Artist
+  , mAlbum :: Album
+  , mYear :: Maybe Year }
+  deriving (Show, Eq)
+
+data ArtistPath = ArtistPath
+  { rootPath :: FilePath
+  , parentPath :: FilePath
+  , childPath :: FilePath }
+  deriving (Show, Eq)
+
+newPath :: ArtistPath -> FilePath
+newPath (ArtistPath _ p c) = p ++ "/" ++ c ++ "/"
+