{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}

module Text.Hastily.MovieSubtitleSources.OpenSubtitles.OpenSubtitles
    (
     getSubtitles
    ) where

import           Control.Exception
import           Control.Monad
import qualified Data.ByteString                                      as BS
import           Data.ByteString.Char8                                as C (split)
import           Data.String.Conversions
import           Data.Text                                            hiding
                                                                       (filter,
                                                                       length,
                                                                       zip,
                                                                       zip3,
                                                                       zipWith)
import           Network.HTTP.Client
import           System.Directory
import           System.FilePath
import           Text.Printf
import           Text.XML.HXT.Core

import qualified Text.Hastily.MovieSubtitleSources.OpenSubtitles.Languages as Ops
import           Text.Hastily.Network
import           Text.Hastily.SubtitleFileTypes.Srt.Srt
import           Text.Hastily.Types
import           Text.Hastily.Unpack.Zip.ZipExtractor

zip4 a b c d = zipWith doZip (zip3 a b c) d
                where
                    doZip (a, b, c) d = (a, b, c, d)


getLang :: Text -> Text
getLang lang = case lookup lang Ops.languages of
                Just lan -> lan
                _ -> error $ cs ( "List of available languages \n" ++ (cs $ intercalate "\n" $ fmap (cs.fst) Ops.languages) ++ "\n\ncannot find language '" ++ (cs lang::String) ++ "'.\n" ::String)

getSubtitles :: MovieInfo -> Text -> Text -> Maybe Text -> FilePath -> IO [FilePath]
getSubtitles movie_info lang cd_count maybe_prefer_slug dst_folder = do
            let language = getLang lang
            links <- getSubtitleLinks movie_info language 0 []
            try $ createDirectory dstSubFolder :: IO (Either SomeException ())
            zipWithM_ (\a b -> extractFromEitherPath $ downloadLink dstSubFolder a b) (filter filterLink links) [1..]
            getSrtFilesInDir dstSubFolder
            where
                filterLink :: (String, String, String, String) -> Bool
                filterLink (link, sub_language, sub_release_name, sub_cd_count) =
                    case maybe_prefer_slug of
                        Nothing -> cd_count == (cs sub_cd_count)
                        Just slug -> let slug_lc = toLower $ slug
                                         release_name_lc = toLower $ (cs sub_release_name::Text)
                                         in cd_count == (cs sub_cd_count) && (isInfixOf slug_lc release_name_lc)
                dstSubFolder = dst_folder </> "opensubtitles.org"

extractFromEitherPath :: IO (Either SomeException FilePath) -> IO (Either SomeException ())
extractFromEitherPath io_either_path = do
    either_path <- io_either_path
    case either_path of
        Left err -> return $ Left err
        Right file_path -> extractFiles file_path

getSubtitleLinks
  :: MovieInfo
     -> Text
     -> Integer
     -> [(String, String, String, String)]
     -> IO [(String, String, String, String)]
getSubtitleLinks movie_info language offset result = do
    (total, item_count, links) <- getResults movie_info language offset
    let new_result = result ++ links
    let link_count = offset + item_count
    if item_count > link_count
        then getSubtitleLinks movie_info language (link_count) new_result
        else return new_result

getResults
  :: MovieInfo
     -> Text
     -> Integer
     -> IO (Integer, Integer, [(String, String, String, String)])
getResults movie_info language offset = do
    result_xml <- getResultXml movie_info language offset
    tc <- itemCount result_xml
    ic <- responseItemCount result_xml
    sub_details <- runX $ result_xml >>> getSubtitleDetails
    let cd_count = []
    let language = []
    let movie_release_names = []
    let subtitle_links = []
    return (tc, ic, sub_details)
    where
        getSubtitleDetails = deep (isElem >>>hasName "subtitle") >>>
            proc x -> do
                subtitle_link <- getAttrValue "LinkDownload" <<< deep (hasName "IDSubtitle") -< x
                release_name <- getText <<< getChildren <<< deep (hasName "MovieReleaseName") -< x
                cd_count <- getText <<< getChildren <<< deep (hasName "SubSumCD") -< x
                language <- getText <<< getChildren <<< deep (hasName "LanguageName") -< x
                returnA -< (subtitle_link, language, release_name, cd_count)
        getResultXml movie_info language offset = do
            response <- (getXmlResponse movie_info language offset)
            return $ response >>>  (deepest (hasName "search")) >>> getChildren >>> (hasName "results")
        itemCount result_xml = do
            item_count_result <- runX ( result_xml >>> getAttrValue "itemsfound")
            return $ (read $ item_count_result!!0::Integer)
        responseItemCount result_xml = do
            item_count_result <- runX ( result_xml >>> getAttrValue "items")
            return $ (read $ item_count_result!!0::Integer)
        getXmlResponse movie_info language offset = do
            either_error_response_text <- getFrom (makeUrl (imdb movie_info) language offset) []
            case either_error_response_text of
                Left err -> error "Quering opensubtitles.org failed!"
                Right response_text -> return $ readString [ withValidate no , withRemoveWS yes] $ cs response_text
            where
            makeUrl :: Text -> Text -> Integer -> String
            makeUrl imdb language offset = printf "http://www.opensubtitles.org/en/search/sublanguageid-%s/imdbid-%s/offset-%s/xml" (cs language::String) (cs imdb::String) (show offset)

downloadLink
  :: Show a =>
     FilePath
     -> (String, t, t1, t2) -> a -> IO (Either SomeException FilePath)
downloadLink dir (link, _, _, _) index = do
    putStrLn $ printf "Downloading %s" link
    request <- parseUrl link
    full_path <- fullPath dir request
    either_err <- getFromUrlAndDo link [] (saveResponse full_path (show index))
    case either_err of
        Left err -> do
            --putStrLn "Downloading failed: " ++ link
            return $ Left err
        Right a -> return $ Right a
    where
        saveResponse path index response = do
            putStrLn $ printf "Saving to %s" path
            response_content <- brConsume $ responseBody response
            BS.writeFile path (BS.intercalate "" response_content)
            return path
        fullPath dir request = do
            let f_name = fileName request
            created <- try $ createDirectory (dir </> f_name) :: IO (Either SomeException ())
            case created of
                Left err -> error $ "ERROR: Cannot create directory " ++ (dir </> f_name)
                Right () -> return $ dir </> f_name </> f_name
            where
                fileName :: Request -> FilePath
                fileName request = cs $ Prelude.last $ C.split '/' (path request)