Created
October 16, 2010 05:29
-
-
Save laclefyoshi/629461 to your computer and use it in GitHub Desktop.
A Command-line Tool for Google Translate
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
-- 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 |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment