
import Data.List
import System

import Network.HTTP
import Network.URI
import Text.JSON
import Text.JSON.Types

gtHost = "ajax.googleapis.com"
gtPath = "/ajax/services/language/translate"
referer = "http://rhydd.org/darcs/gtrans/"

mkURI lang1 lang2 s = URI {
    uriScheme = "http",
    uriAuthority = Just $ URIAuth "" gtHost "",
    uriPath = gtPath,
    uriQuery = ('?':) $ escapeURIString isUnescapedInURI $ intercalate "&" [
        "v=1.0",
        "q=" ++ s,
        "langpair=" ++ lang1 ++ "|" ++ lang2],
    uriFragment = "" }

-- Result objects should look like this:
--   {"responseData":    {"translatedText":"ciao mondo"},
--    "responseDetails": null,
--    "responseStatus":  200}

parseResult result =
    let resultObj = fromJSObject result in
    case (lookup "responseStatus" resultObj,
          lookup "responseDetails" resultObj,
          lookup "responseData" resultObj) of
        (Just (JSRational False 200),
         Just JSNull,
         Just (JSObject (JSONObject
            [("translatedText", JSString (JSONString text))]))) ->
            Right text
        (Just (JSRational False status),
         Just (JSString (JSONString err)),
         Just JSNull) ->
            Left . concat $ ["error ", show $ truncate status, ": ", err]
        _ ->
            Left . concat $ ["unexpected result data: ", show result]

getTranslation lang1 lang2 text = do
    let uri = mkURI lang1 lang2 text
    let req = Request {
        rqMethod = GET,
        rqURI = uri,
        rqHeaders = [Header HdrReferer referer],
        rqBody = "" }
    result <- simpleHTTP req
    case result of
        Left err -> return . Left . show $ err
        Right rsp ->
            case rspCode rsp of
                (2, 0, 0) ->
                    case decode $ rspBody rsp of
                        Error err -> return . Left $ err
                        Ok (JSObject v) -> return . parseResult $ v
                _ -> return . Left $ "HTTP request failed: " ++ rspBody rsp

oops e = putStrLn e >> exitFailure

main = do
    prog <- getProgName
    args <- getArgs
    case args of
        [lang1, lang2, text] ->
            getTranslation lang1 lang2 text >>= \result ->
                case result of
                    Left err -> oops err
                    Right text -> putStrLn text
        _ -> oops . concat $ ["usage: ", prog, " lang1 lang2 text"]

