-- Copyright: 2004-2012 Dino Morelli
-- License: BSD3 (see LICENSE)
-- Author: Dino Morelli <dino@ui3.info>

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

import Audio.TagLib.TagLib
import Control.Monad
import Control.Monad.Error
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import System.Directory
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.Posix.Files
import Text.Printf

import MonadOr
import Opts
import PathSanitizer


instance MonadOr []


type Ren a = ReaderT Options IO a

runRename :: Options -> Ren a -> IO a
runRename env action = runReaderT action env


{- All filters to be applied by the path sanitizer. Order matters!

   This chart was helpful:
   http://www.utf8-chartable.de/unicode-utf8-table.pl?number=1024
-}
filters :: [String -> String]
filters =
   [ upcaseAfter " -()[]"
   , subst "\\[" "_"
   , subst "\\(" "_"
   , removeAny " ()],'#?.-~!"
   , subst "&" "And"
   , subst "@" "At"
   --, subst "_The" ""
   , subst ":" "_"
   , subst "\"" "In"
   , subst "/" "_"
   , subst "\x00e0" "a"
   , subst "\x00e1" "a"
   , subst "\x00e2" "a"
   , subst "\x00e3" "a"
   , subst "\x00e4" "a"
   , subst "\x00e5" "a"
   , subst "\x00e6" "ae"
   , subst "\x00e7" "c"
   , subst "\x00e8" "e"
   , subst "\x00e9" "e"
   , subst "\x00ea" "e"
   , subst "\x00eb" "e"
   , subst "\x00ec" "i"
   , subst "\x00ed" "i"
   , subst "\x00ee" "i"
   , subst "\x00ef" "i"
   , subst "\x00f1" "n"
   , subst "\x00f2" "o"
   , subst "\x00f3" "o"
   , subst "\x00f4" "o"
   , subst "\x00f5" "o"
   , subst "\x00f6" "o"
   , subst "\x00f9" "u"
   , subst "\x00fa" "u"
   , subst "\x00fb" "u"
   , subst "\x00fc" "u"
   ]


{- Some strings (like artist and album name) we want to be devoid of
   "The " as well for purposes of making nice, sortable directory names.
-}
filtersWithThe :: [String -> String]
filtersWithThe = (subst "^The " "") : filters


buildNewPath :: (MonadError String m, MonadIO m) =>
   FilePath -> m (FilePath, FilePath)
buildNewPath oldPath = do
   let ext = takeExtension oldPath

   mbtf <- liftIO $ tagFileOpen $ BS.pack oldPath
   when (isNothing mbtf) $ throwError $ "Unable to open " ++ oldPath

   mbt <- liftIO $ tagFileGetTag $ fromJust mbtf
   when (isNothing mbt) $ throwError $ "No tags in " ++ oldPath

   let t = fromJust mbt

   ar <- liftIO $ liftM (sanitize filtersWithThe) $ tagGetArtist t
   when (ar == "") $ throwError $ "No artist in " ++ oldPath

   al <- liftIO $ do
      a <- liftM (sanitize filtersWithThe) $ tagGetAlbum t
      return $ a `morelse` "unsorted"

   ti <- liftIO $ liftM (sanitize filters) $ tagGetTitle t
   when (ar == "") $ throwError $ "No title in " ++ oldPath

   let newSubDir = ar </> al
   let newFile = printf "%s-%s%s" ar ti ext

   return (newSubDir, newFile)


createNewLink :: FilePath -> FilePath -> Ren ()
createNewLink newDir oldPath = do
   opts <- ask
   result <- liftIO $ runErrorT $ do
      (newSubDir, newFile) <- buildNewPath oldPath

      let newPath = if (optNoDirs opts)
            then newDir </> newFile
            else newDir </> newSubDir </> newFile

      -- Check for existance of the target file
      exists <- liftIO $ fileExist newPath
      when exists $ throwError $ "Destination " ++ newPath ++ " exists!"

      unless (optQuiet opts) $
         liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath

      unless (optNoAction opts) $ do
         -- Make the target dir
         unless (optNoDirs opts) $
            liftIO $ createDirectoryIfMissing True $ takeDirectory newPath

         -- Make the new hard link
         liftIO $ createLink oldPath newPath

         -- If the user has specified, remove the original link
         when (optMove opts) $
            liftIO $ removeLink oldPath

   let errPrefix = "** Processing " ++ oldPath ++ ": "

   case result of
      Left errMsg -> liftIO $ hPutStrLn stderr $ errPrefix ++ errMsg
      Right _ -> return ()


-- Figure out and execute what the user wants based on the supplied args
executeCommands :: [String] -> Ren ()

-- User gave no files at all. Display help
executeCommands [] = liftIO $ do
   putStrLn usageText
   exitWith $ ExitFailure 1

-- User gave just a dir and no files at all. Display help
executeCommands [_] = executeCommands []

-- Normal program operation, process the files with the args.
executeCommands (dir:filePaths) = do
   opts <- ask

   actualPaths <- liftIO $ filterM
      (\p -> getFileStatus p >>= return . isRegularFile) filePaths

   when (optNoAction opts) $
      liftIO $ putStrLn "No-action mode, nothing will be changed."

   when (optMove opts) $
      liftIO $ putStrLn
         "Removing original links after new links are in place."

   -- Do the link manipulations
   mapM_ (createNewLink dir) actualPaths


main :: IO ()
main = do
   (opts, paths) <- getArgs >>= parseOpts
   runRename opts $ executeCommands paths