import Control.Monad
import Data.List
import Data.Char
import System.Console.GetOpt
import System.Directory
import System.Environment
import System.FilePath
import System.Cmd
import System.Exit
import System.IO

main :: IO ()
main = do
 args <- getArgs
 case getOpt Permute options args of
   (opts, [rootDir], _) -> do
     sanityCheck opts
     ex <- doesDirectoryExist rootDir
     if ex
        then fixWavFiles (mkFlags opts) rootDir
        else error ("Directory " ++ rootDir ++ " does not exist!")
   _ -> error (usageInfo header options)
     where header = "Usage: wavconvert [OPTION...] directory"

mkFlags :: [Flag] -> Flags
mkFlags opts = Flags {dry=DryRun `elem` opts, verbose=Verbose `elem` opts,
                      remove=RemoveFiles `elem` opts}

sanityCheck :: [Flag] -> IO ()
sanityCheck opts | DryRun `elem` opts && RemoveFiles `elem` opts = 
  error "You cannot remove files in a dry run"
sanityCheck _ = return ()

fixWavFiles :: Flags -> FilePath -> IO ()
fixWavFiles f rootDir = do
  wavFiles <- getFiles rootDir ((== ('.':oldExtension)) . takeExtension)
  fixtags f wavFiles
  when (dry f) (inform $ "\n\nThis was a dry run; I did not execute any of the"
        ++ " above commands.")
  when (remove f) (promptRemove wavFiles)

getFiles :: FilePath -> (FilePath -> Bool) -> IO [FilePath]
getFiles rootDir p = do
  stuff <- getDirectoryContentsRecursive rootDir
  return (filter p stuff)


fixtags :: Flags -> [FilePath] -> IO ()
fixtags f = mapM_ fixtag
  where fixtag fn =
          let dirs = splitDirectories fn in
            if length dirs < 3 
               then error ("Weird file path: " ++ fn)
               else do
                 let (title:(album:(artist:_))) = reverse dirs
                 let (trackNum, songTitle) =
                         case span isDigit title of
                           (n, rest) -> (n, 
                             dropExtension $ dropWhile (not . isAlphaNum) rest)
                 let newFileName = fn `replaceExtension` newExtension
                 ex <- doesFileExist newFileName
                 if ex 
                   then warn ("Skipping file: " ++ newFileName ++ " because it already exists")
                   else do let cmdLine = mkCmdLine songTitle artist album trackNum newFileName fn 
                           doSystem f cmdLine

mkCmdLine :: String -> String -> String -> String -> FilePath -> FilePath -> String
mkCmdLine songTitle artist album trackNum newFileName fn = 
   program ++ (spaces titleFlag) ++ quote songTitle 
       ++ (spaces trackNumFlag) ++ trackNum 
       ++ (spaces artistFlag) ++ quote artist 
       ++ (spaces albumFlag) ++ quote album 
       ++ (spaces outFlag) ++ (quote newFileName)
       ++ " " ++ quote fn

doSystem :: Flags -> String -> IO ()
doSystem (Flags{dry=d, verbose=v}) s = do
  when (d || v) $ putStrLn s
  unless d $ do 
    res <- system s
    case res of
      ExitFailure c -> error ("Command " ++ s ++ " failed with " ++ show c)
      ExitSuccess   -> return ()

promptRemove :: [FilePath] -> IO ()
promptRemove fs = do
  inform ("About to remove the following files:")
  inform (format fs)
  putStr ("Are you sure you really want to remove these files? [yN]:")
  hFlush stdout
  reply <- getLine
  case reply of
    "y" -> mapM_ removeFile fs
    _   -> inform ("You said you didn't really want to remove the files, so"
             ++ " I'm not removing them.")

format :: [FilePath] -> String
format fs = intercalate "\n" (map ("  " ++) fs)
-----------------
isntDot :: [FilePath] -> [FilePath]
isntDot = filter (\ thing -> not ("." `isPrefixOf` thing))

getDirectoryContentsRecursive :: FilePath -> IO [FilePath]
getDirectoryContentsRecursive d = do
  ex <- doesDirectoryExist d
  if ex 
    then do 
      first <- (liftM isntDot)$  getDirectoryContents d
      rest <- mapM getDirectoryContentsRecursive (map (d </>) first)
      return $ (map (d </>) first) ++ (isntDot (concat rest))
    else (return [])
-----------------
data Flag = DryRun | Verbose | RemoveFiles
  deriving Eq

data Flags = Flags {
      dry :: Bool, verbose :: Bool, remove :: Bool
      }

options :: [OptDescr Flag]
options =
  [Option ['d'] ["dry-run"] (NoArg DryRun) 
    ("Do not run any commands, but instead print out the commands that would have"
    ++  "been executed"),
   Option ['v'] ["verbose"] (NoArg Verbose)
    "Print out each command as it is being executed",
   Option ['r'] ["remove-files"] (NoArg RemoveFiles)
    "Delete old files after processing"]

newExtension, oldExtension, program :: String
newExtension = "ogg"
oldExtension = "wav"
program      = "oggenc"
trackNumFlag, artistFlag, albumFlag, outFlag, titleFlag :: String
trackNumFlag = "-N"
artistFlag = "-a"
albumFlag = "-l"
outFlag = "-o"
titleFlag = "-t"
quote, spaces :: String -> String
quote s = "\"" ++ (escape s) ++ "\""
  where escape ""        = ""
        escape ('\"':xs) = "\\\"" ++ (escape xs)
        escape (c:xs)    = c:(escape xs)
spaces s = " " ++ s ++ " "

warn :: String -> IO ()
warn s = putStrLn ("WARNING: " ++ s)

inform :: String -> IO ()
inform = putStrLn