module Main where

import List
import Char
import Control.Monad
import Text.HTML.TagSoup
import Text.HTML.Download
import Maybe
import Network.HTTP
import Network.URI

import System.Directory
import System.FilePath.Posix
import System.Environment (getArgs)
import System.Exit (exitFailure)
import System.IO

{-
    Seeqsuqr - A Seeqpod.com scraping tool in Haskell
    
    Seeqsuqr provides a commandline interface to scraping 
    Seeqpod for music.  Usage:
    
    Seeqsuqr.exe <username>
        
        List playlists for username.
    
    Seeqsuqr.exe <username> <playlist>
        
        Download all MP3 files in playlist.  Files will be stored in
        relative path <username/<playlist>/*.mp3
    
    TODO:
        Read ID3 tags and rename MP3 files according to rules.
        Only download files needed (by timestamp? filesize?).
        More command line options?
    
-}

data PlayList = PlayList { 
    playListPid :: String,
    playListName :: String,
    playListUrl :: String
} deriving (Show)

split :: Char -> String -> [String]
split = unfoldr . split'

split' :: Char -> String -> Maybe (String, String)
split' c l
    | null l = Nothing
    | otherwise = Just (h, drop 1 t)
    where (h, t) = span (/=c) l

href :: Tag -> Maybe String
href (TagOpen _ attrs) = lookup "href" attrs
href _ = Nothing -- We aren't interested in other stuff.

urlParams url =
    let params = split '&' $ (split '?' url)!!1
        kv param =
            let (k:v:_) = split '=' param
            in (k,v)
    in  map kv params

linkTags tags = filter isTagOpen $ head $ sections (~== ("<a>")) tags

links tags = catMaybes $ map href $ linkTags tags

userPrefixRange url = 
    let pmap = urlParams url
    in (lookup "umin" pmap, lookup "umax" pmap)

getUserRange :: String -> IO String
getUserRange userName = 
    let userInitial = userNameInitial userName
        url = "http://www.seeqpod.com/api/iphone/ukeylist?key=" ++ userInitial
        isMatchingRange :: String -> Bool
        isMatchingRange url' =
            let userPre = take 3 userName
            in  case userPrefixRange url' of
                    (Just a, Just b) -> (a <= userPre) && (b >= userPre)
                    otherwise -> False
    in do
        src <- getURL url;
        tags <- return $ parseTags src;
        rangeUrl <- return $ head $ 
            filter isMatchingRange $ links tags;
        return rangeUrl;
    
userNameInitial userName = (toUpper $ head userName) : ""

userRangeUrl (umin,umax) =
    concat [
        "http://www.seeqpod.com/api/iphone/ukeylist?umin=",
        umin, "&umax=", umax ]

getUserPage :: String -> IO String
getUserPage userName = do
    usersUrlFrag <- getUserRange userName
    usersUrl <- return $ "http://www.seeqpod.com" ++ usersUrlFrag
    usersSrc <- getURL usersUrl
    tags <- return $ parseTags usersSrc
    userUrl <- return $ 
        "http://www.seeqpod.com" ++ (head $ filter isUserLink $ links tags)
    getURL userUrl
    where
        isUserLink link =
            let params = urlParams link
                linkUser = lookup "uname" params
            in  case linkUser of
                    Just user -> user == userName
                    Nothing -> False

getPlayLists userName = do
    userSrc <- getUserPage userName
    tags <- return $ parseTags userSrc
    playlists <- return $ catMaybes $ map getPlayList $ links tags
    return playlists
    where
        getPlayList :: String -> Maybe PlayList
        getPlayList link =
            let params = urlParams link
                name = lookup "name" params
                pid = lookup "pid" params
            in  case (name,pid) of
                    (Just name', Just pid') -> 
                        Just $ PlayList pid' name' ("http://www.seeqpod.com" ++ link)
                    otherwise -> Nothing

getPlayListPage playList = do
    getURL $ playListUrl playList

getMp3Links :: PlayList -> IO [String]
getMp3Links playList = do
    src <- getPlayListPage playList
    tags <- return $ parseTags src
    liftM catMaybes $ mapM followRedirectLink $ links tags
    where
        followRedirectLink :: String -> IO (Maybe String)
        followRedirectLink url' = do
            src' <- getURL ("http://www.seeqpod.com" ++ url')
            tags' <- return $ parseTags src'
            case links tags' of
                (x:xs) -> return $ Just x
                _ -> return Nothing
    
err :: String -> IO a
err msg = do 
      hPutStrLn stderr msg
      exitFailure

getURL url = get $ fromJust $ parseURI url

get :: URI -> IO String
get uri = do
    eresp <- simpleHTTP (request uri)
    resp <- handleE (err . show) eresp
    case rspCode resp of
        (2,0,0) -> return (rspBody resp)
        (3,_,_) -> return (rspBody resp) -- TODO: follow redir
        _ -> err (httpError resp)
    where
        showRspCode (a,b,c) = map intToDigit [a,b,c]
        httpError resp = showRspCode (rspCode resp) ++ " " ++ rspReason resp

request :: URI -> Request
request uri = Request{ rqURI = uri,
                       rqMethod = GET,
                       rqHeaders = [],
                       rqBody = "" }

handleE :: Monad m => (ConnError -> m a) -> Either ConnError a -> m a
handleE h (Left e) = h e
handleE _ (Right v) = return v

main :: IO ()
main = do
    args <- getArgs
    case args of
        (userName:[]) -> printPlayLists userName
        (userName:playList:[]) -> downloadPlayList userName playList
        _ -> printHelp

printHelp = do
    putStrLn "Coming Soon..."

printPlayLists userName = do
    playLists <- getPlayLists userName
    mapM putStrLn $ map playListName playLists
    return ()

downloadPlayList userName playListName' = let 
    dlPath = joinPath [userName, playListName']
    in do
        playLists <- getPlayLists userName
        createDirectoryIfMissing True dlPath
        case filter (\x -> playListName x == playListName') playLists of
            (playList:xs) -> do
                mp3Links <- getMp3Links playList
                mapM_ (downloadFile dlPath) $ mp3Links
            _ -> return ()

downloadFile dir url = let
    basefile = head $ reverse $ splitPath url
    file = joinPath [dir, basefile]
    in do
        putStr $ "Downloading " ++ url ++ " to " ++ file ++ "..."
        outFile <- openBinaryFile file WriteMode
        contents <- getURL url
        hPutStr outFile contents
        hClose outFile
        putStrLn "Done"