{-
 - The modules implements the MPD protocol for interfacing 
 - with the MPD daemon.
 -}
module Hmpf.MPD 
           ( albums 
           , artists 
	   , tracks
	   , albumByTrack
	   , tracksByArtist
	   , status 
	   , MPDStatus (..) 
	   , currentsong 
	   , Song (..) 
	   , playAlbum
	   , vol
	   , pause
	   , nextSong
	   , previousSong
	   , play
	   , stop
	   , fastforward
	   , rewind
	   , command
	   , updatedb
	   , clear
	   , addSongs
	   , playlistinfo 
	   , playlistinfoAt
	   , albumByArtist ) where

import Network
import System.IO (hFlush, hClose , Handle , hSetBuffering , BufferMode(..) )
import System.IO.Error (catch)
import Data.List
import Data.Maybe
import Data.Char
import Hmpf.Util
import Hmpf.UTF8Stream
import Control.Exception
import Network (PortID)

--host = "10.1.1.4"
--port = PortNumber 6600

playAlbum conf alb = do
 putStrLn "playing new album"
 response <- command conf ("find album " ++ (quote alb) )
 case response of 
  OK resp -> do
             let files = map snd . filter file . map property $ resp
                 cmdLst = "stop":"clear":((map (("add " ++) . quote ) files) ++ ["play"])
             commands conf cmdLst
             return ()
  ACK resp -> putStrLn resp
 where
  file = \(a,_) -> a == "file"

vol conf i = do
 case i > 0 of 
  True -> command conf $ "volume +" ++ (show i)
  False -> command conf $ "volume " ++ (show i)
 status conf >>= ( return . volume )

albums :: (String,PortNumber) -> IO [String]
albums conf = listByProperty conf "album"

listByProperty :: (String,PortNumber) -> String -> IO [String]
listByProperty conf prop = do
 OK lst <- command conf ( "list " ++ prop ) 
 let albs = sort . map ( snd . property ) $ lst
 return albs

tracks :: (String,PortNumber) -> IO [String]
tracks conf = listByProperty conf "title"

clear :: (String,PortNumber) -> IO ()
clear conf = do
 st <- status conf
 let lst = do
            s <- song st
            len <- playlistlength st
            return . reverse . filter (/=s) $ [0..(len-1)]
 case lst of
  Nothing -> putStrLn "Clear all" >> command conf "clear" >> return ()
  Just is -> (commands conf . map ( (\s -> "delete " ++ s ) . show ) $ is)  >> return ()

artists ::  (String,PortNumber) ->IO [String]
artists conf = do
 OK lst <- command conf "list artist"
 return . sort . map ( snd . property ) $ lst

albumByTrack ::  (String,PortNumber) ->String -> IO [String]
albumByTrack conf art = do
 let cmdstr = "list album title " ++ (quote art )
 OK lst <- command conf cmdstr
 return . map (snd.property) $ lst

albumByArtist ::  (String,PortNumber) ->String -> IO [String]
albumByArtist conf art = do
 let cmdstr = "list album artist " ++ (quote art )
 OK lst <- command conf cmdstr
 return . map (snd.property) $ lst

data MPDStatus = MPDStatus {
                  volume :: Int
		 ,repeat :: Int
		 ,random :: Int
		 ,playlist :: Maybe Int
		 ,playlistlength :: Maybe Int
		 ,state :: String
		 ,song :: Maybe Int
		 ,elapsed :: Maybe Int
		 ,duration :: Maybe Int
		 ,songid :: Maybe Int
		 }
 deriving Show

tracksByArtist ::  (String,PortNumber) ->String -> IO [Song]
tracksByArtist conf art = do
 let req = "find artist \"" ++ art ++ "\"" 
 putStr req
 --resp <- command conf ("search artist \"" ++ art ++ "\"" )
 resp <- command conf req
 case resp of
  OK xs -> found xs >> (return . f $ xs)
  _ -> return []
 where
  found [] = putStrLn ""
  found _ = putStrLn " - found!"
  f [] = []
  f (y:ys) = let (a,b) = break ( `startsWith` "file:" ) ys
             in ( readSong (y:a)) : ( f b )

currentsong :: (String,PortNumber) -> IO (Maybe Song)
currentsong conf = do
 resp <- command conf "currentsong"
 case resp of 
  OK xs -> do
   return . Just . readSong $ xs
  _ -> return Nothing


playlistinfo ::  (String,PortNumber) -> IO [Song]
playlistinfo conf = do
 resp <- command  conf ("playlistinfo")
 case resp of
  OK xs ->  (return . f $ xs)
  _ -> return []
 where
  f [] = []
  f (y:ys) = let (a,b) = break ( `startsWith` "file:" ) ys
             in ( readSong (y:a)) : ( f b )

playlistinfoAt ::  (String,PortNumber) ->Int -> IO (Maybe Song)
playlistinfoAt conf i = do
 resp <- command  conf ("playlistinfo " ++ ( show i ))
 case resp of 
  OK xs -> return . Just . readSong $ xs
  _ -> return Nothing

readSong :: [String] -> Song
readSong (x:xs) = 
 Song f tm al a t g sid 
 where m = map property (x:xs)
       t = maybe "notfound" id (lookup "Title" $ m)
       a = maybe "notfound" id (lookup "Artist" $ m)
       al = maybe "notfound" id (lookup "Album" $ m)
       g = maybe "notfound" id (lookup "Genre" $ m)
       f = maybe "notfound" id (lookup "file" $ m)
       tm = maybe 0 read (lookup "Time" $ m)
       sid = maybe 0 read (lookup "Id" $ m)
data Song = Song {
               file :: String
	     , time :: Int
	     , album :: String
	     , artist :: String
	     , title :: String
	     , genre :: String
	     , songId :: Int
	     }
 deriving (Show,Eq)

status :: (String,PortNumber) -> IO MPDStatus
status conf = do
 OK lst <- command conf "status"
 let m = map property lst
     v = maybe 0 read (lookup "volume" $ m)
     rp = maybe 0 read (lookup "repeat" $ m)
     ran = maybe 0 read (lookup "random" $ m)
     pl = lookup "playlist" m >>= (return . read)
     pll = lookup "playlistlength" m >>= (return . read)
     st = maybe "stop" id (lookup "state" m)
     s = lookup "song" m >>= (return . read)
     e = lookup "time" m >>= (return . read . takeWhile isDigit)
     d = lookup "time" m >>= (return . read . reverse . takeWhile isDigit . reverse )
     sid = lookup "songid" m >>= ( return . read )
 return (MPDStatus v rp ran pl pll st s e d sid)


command = command'
{-
 catch (command' (host,port) cmd)
       (\e -> do
         let msg = "MPD - " ++ (show e)
         putStrLn msg
	 return (ACK msg)
       )
-}

command' :: (String, PortNumber) -> String -> IO Response
command' (host,port) cmd = do
 h <- connectTo host (PortNumber port)
 finally (sendCmd h)  (hFlush h >> hClose h ) -- >> (putStrLn " - closed") )
 where 
  sendCmd h = do 
 	-- putStr $ "MPD Command : " ++ cmd
 	ln <- hGetLine h
 	hPutStrLn h cmd
 	resp <- mpdResp [] h
 	-- putStrLn $ "MPD Response : " ++ ( show resp )
 	return resp


commands = commands'
--commands conf lst = 
-- sequence . map ( command conf ) $ lst

commands' :: (String , PortNumber) -> [String] -> IO Response
commands' (host, port) clst = do
 h <- connectTo host (PortNumber port)
 finally (sendCmds h)  (hFlush h >> hClose h ) -- >> (putStrLn " - closed") )
 where
  sendCmds h = do
   	-- hSetBuffering h NoBuffering
 	hGetLine h
 	--putStr "MPD Commands:"
	--mapM_ putStrLn clst
 	hPutStrLn h "command_list_begin"
 	mapM_ (hPutStrLn h) clst
 	hPutStrLn h "command_list_end"
 	resp <- mpdResp [] h
	hPutStrLn h "close"
	putStrLn . show $ resp
 	return resp


mpdResp :: [String] -> Handle -> IO Response
mpdResp buf h = do
 line <- hGetLine h
 if line `startsWith` "ACK" 
  then 
   return . ACK . drop 2 . dropWhile (\c -> c/='}') $ line
  else if line `startsWith` "OK" 
        then 
	 return $ OK ( reverse buf )
        else 
	 mpdResp (line:buf) h

data Response = 
 OK [String] | 
 ACK String
 deriving Show

property :: String -> (String,String)
property xs = 
 let key = takeWhile (\c -> c/=':') xs
     val = drop (length key + 2 ) xs
 in ( key , val )

pause conf = command conf "pause"
nextSong conf = command conf "next"
previousSong conf = command conf "previous"
play conf = command conf "play"
stop conf = command conf "stop"
fastforward conf = jog conf 2
rewind conf = jog conf (-2)
updatedb conf = command conf "update"

--Advance a song by 'n' seconds
jog conf n = do
 s <- status conf
 case (song s) of
  Nothing -> do return ()
  Just i -> do
            let position = ( +n ) . fromJust . elapsed $ s
                cmd = "seek " ++ (show i) ++ " " ++ (show position)
	    command conf cmd
	    return ()

quote :: String -> String 
quote str = '"':str ++ "\""

addSongs :: (String,PortNumber) -> [Song] -> IO ()
addSongs conf xs = do
 commands conf lst 
 return ()
 where
  lst = map ( (\f -> "add \"" ++ f ++ "\"" ) . file)  $ xs