{-# LANGUAGE DeriveDataTypeable, OverloadedStrings #-}
module NicovideoTranslator.Main (main) where

import Data.Char (toLower)
import System.IO (stderr, stdout)
import System.IO.Error (catchIOError)

import Data.Data (Data)
import qualified Data.LanguageCodes as L
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Text.Format (Format, format)
import Data.Text.Format.Params (Params)
import Data.Text.Format.Types (Only(Only))
import Data.Text.IO (hPutStrLn)
import qualified Data.Text.Lazy as LT
import Data.Typeable (Typeable)
import Network.DNS.Resolver (defaultResolvConf, makeResolvSeed, withResolver)
import Network.DNS.Lookup (lookupA)
import Network.Wai.Handler.Warp (Port, run)
import System.Console.CmdArgs (cmdArgs, help, typ, (&=))
import System.Locale.SetLocale (Category(LC_CTYPE), setLocale)

import NicovideoTranslator.Proxy (ProxyConfiguration(ProxyConfiguration), app)

data Translator = Translator { port :: Port
                             , language :: String
                             } deriving (Show, Data, Typeable)

formatIoError :: Params ps => Format -> ps -> IO a
formatIoError fmt ps = ioError $ userError $ LT.unpack $ format fmt ps 

readLanguageCode :: [Char] -> IO L.ISO639_1
readLanguageCode (x:y:[]) =
    case L.fromChars (toLower x) (toLower y) of
        Just lang -> return lang
        _ -> formatIoError "{} is wrong language code" (Only (x:y:[]))
readLanguageCode lang = formatIoError "{} is wrong language code" (Only lang)

currentLanguage :: IO L.ISO639_1
currentLanguage = do
    currentLocale <- setLocale LC_CTYPE Nothing
    case currentLocale of
        Just s -> readLanguageCode s
        Nothing -> formatIoError "locale is not set" ()

defaultUpstreamHost :: T.Text
defaultUpstreamHost = "msg.nicovideo.jp"

translateCmdArgs :: String -> Translator
translateCmdArgs lang =
    Translator { language = lang &= typ "LANG"
                                 &= help "Target language to translate to [en]"
               , port = 80 &= typ "PORT"
                           &= help "Port number to listen [80]"
               }

main :: IO ()
main = do
    currentLang <- catchIOError currentLanguage (\_ -> return L.EN)
    opts <- cmdArgs $ translateCmdArgs $ L.language currentLang
    lang <- readLanguageCode $ language opts
    let portNum = port opts
    hPutStrLn stdout $ LT.toStrict $
        format "Running on http://0.0.0.0:{}/ (Press ^C to quit)" (Only portNum)
    rs <- makeResolvSeed defaultResolvConf
    resolution <- withResolver rs $
        \resolver -> lookupA resolver (encodeUtf8 defaultUpstreamHost)
    case resolution of
        Right (resolvedHost:_) ->
            let upstreamHost = T.pack $ show resolvedHost
            in do
                hPutStrLn stdout $ T.concat ["Upstream: "
                                            , defaultUpstreamHost
                                            , " (", upstreamHost, ")"
                                            ]
                run portNum $ app (ProxyConfiguration lang upstreamHost)
        _ -> hPutStrLn stderr $ T.concat [ "error: failed to resolve "
                                         , defaultUpstreamHost
                                         ]