A Command-line Tool for Google Translate

translator.hs

-- A Command-line Tool for Google Translate
-- Copyright : (c) SAEKI Yoshiyasu
-- License   : MIT-style license <http://www.opensource.org/licenses/mit-license.php>
-- last updated: 2010/10/16

import Network.URI
import Data.List
import Network.HTTP
import Text.JSON
import System
import System.Console.GetOpt
import Data.Maybe (fromMaybe)

urlencode :: String -> String
urlencode s = escapeURIString isAlphaNum s
              where
                isAlphaNum c = elem c (['0'..'9'] ++ ['A'..'Z'] ++ ['a'..'z'])

mkParams :: [(String, String)] -> String
mkParams sss = (intercalate "&") $ map pair sss
               where
                 pair e = (urlencode $ fst e) ++ "=" ++ (urlencode $ snd e)

type URL = String

mkGtUrl :: Options -> String -> URL
mkGtUrl optlist text = baseurl ++ (mkParams params)
            where
              baseurl = "http://ajax.googleapis.com/ajax/services/language/translate?"
              params = [("v", "1.0"), ("langpair", fl ++ "|" ++ tl), ("q", text)]
              (Just fl) = froml optlist
              (Just tl) = tol optlist

getHTTPContent :: URL -> IO String
getHTTPContent url = (simpleHTTP $ insertHeader HdrReferer myUrl $ getRequest url)
                     >>= getResponseBody
                         where myUrl = "http://d.hatena.ne.jp/LaclefYoshi/"

toJV :: String -> JSValue
toJV content = let Ok value = decodeStrict content
               in value

getTranslatedtext :: JSValue -> String
getTranslatedtext (JSObject v) = let Ok (JSObject rd) = valFromObj "responseData" v
                                 in let Ok tt = valFromObj "translatedText" rd
                                    in fromJSString tt

data Options = Options {froml :: Maybe String,
                        tol   :: Maybe String} deriving Show

defaultOptions :: Options
defaultOptions = Options {froml  = Just "en", tol = Just "ja"}

options :: [OptDescr (Options -> Options)]
options =
    [ Option ['f'] ["from"]
        (OptArg ((\f opts -> opts { froml = Just f }) . fromMaybe "en") "lang") "FROM",
      Option ['t'] ["to"]
        (OptArg ((\t opts -> opts { tol = Just t }) . fromMaybe "ja") "lang") "TO" ]

compilerOpts :: [String] -> IO (Options, [String])
compilerOpts argv =
    case getOpt Permute options argv of
      (o,n,[]  ) -> return (foldl (flip id) defaultOptions o, n)
      (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options))
        where header = "Usage: PROGRAM [OPTION...] files..."

main :: IO ()
main = do
  argv <- getArgs
  (opts, optvalues) <- compilerOpts argv
  text <- getContents
  content <- getHTTPContent $ mkGtUrl opts text
  putStrLn $ getTranslatedtext $ toJV content