nicovideo-translator 0.1.0.1 → 0.2.0.0
raw patch · 5 files changed
+169/−68 lines, 5 filesdep +aesondep +asyncdep +lens-aesondep −naver-translatedep ~basedep ~dnsdep ~http-types
Dependencies added: aeson, async, lens-aeson, unordered-containers
Dependencies removed: naver-translate
Dependency ranges changed: base, dns, http-types, lens, text, wai, warp, wreq, xml-conduit
Files
- README.md +18/−14
- lib/NicovideoTranslator/Main.hs +41/−10
- lib/NicovideoTranslator/Proxy.hs +27/−15
- lib/NicovideoTranslator/Translate.hs +54/−13
- nicovideo-translator.cabal +29/−16
README.md view
@@ -15,15 +15,15 @@ $ cabal install nicovideo-translator -Aliasing `msg.nicovideo.jp` to localhost-----------------------------------------+Aliasing `nmsg.nicovideo.jp` to localhost+----------------------------------------- To make the translator to intercept comments from Nico Nico comment server,-you have to alias Nico Nico comment server domain (`msg.nicovideo.jp`) to+you have to alias Nico Nico comment server domain (`nmsg.nicovideo.jp`) to your localhost (`127.0.0.1`). Open your [hosts file][2] using text editor (you probably need administrator permission), and then add the following line: - 127.0.0.1 msg.nicovideo.jp+ 127.0.0.1 nmsg.nicovideo.jp [2]: http://en.wikipedia.org/wiki/Hosts_%28file%29 @@ -35,30 +35,34 @@ you watch Nico Nico videos. You can invoke the proxy server using CLI (you probably need administrator permission to listen 80 port): - $ nicovideo-translator+ $ nicovideo-translator EiP3NSgLid81OjSwpOMkgV0rzD9SLHRqwqUwx2r Running on http://0.0.0.0:80/ (Press ^C to quit)- Upstream: msg.nicovideo.jp (202.248.110.173)+ Upstream: nmsg.nicovideo.jp (202.248.110.173) +Note that it takes a [Google Translate API][3] key as its first argument.+ You can terminate the server by pressing Ctrl-C. It can optionally take the target language which is a two-letter-e.g. `en`, `ko` through `-l`/`--language` option:+e.g. `en`, `ko` through `-l`/`--lang`/`--language` option: - $ nicovideo-translator --language ko+ $ nicovideo-translator -l ko +[3]: https://cloud.google.com/translate/ + Open source ----------- -It's written by [Hong Minhee][3], and distributed under [AGPLv3][].-You can find the source code from the [Git repository][4]:+It's written by [Hong Minhee][4], and distributed under [AGPLv3][].+You can find the source code from the [Git repository][5]: $ git clone git://github.com/dahlia/nicovideo-translator -Please report bugs to the [issue tracker][5] if you find.+Please report bugs to the [issue tracker][6] if you find. Pull requests welcome! -[3]: http://hongminhee.org/-[4]: https://github.com/dahlia/nicovideo-translator-[5]: https://github.com/dahlia/nicovideo-translator/issues+[4]: https://hongminhee.org/+[5]: https://github.com/dahlia/nicovideo-translator+[6]: https://github.com/dahlia/nicovideo-translator/issues [AGPLv3]: http://www.gnu.org/licenses/agpl-3.0.html
lib/NicovideoTranslator/Main.hs view
@@ -18,13 +18,31 @@ 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.Console.CmdArgs ( argPos+ , cmdArgs+ , def+ , details+ , explicit+ , help+ , name+ , program+ , summary+ , typ+ , (&=)+ ) import System.Locale.SetLocale (Category(LC_CTYPE), setLocale) -import NicovideoTranslator.Proxy (ProxyConfiguration(ProxyConfiguration), app)+import NicovideoTranslator.Proxy ( ProxyConfiguration ( ProxyConfiguration+ , apiKey+ , language+ , upstreamHost+ )+ , app+ ) data Translator = Translator { port :: Port- , language :: String+ , language' :: String+ , apiKey' :: String } deriving (Show, Data, Typeable) formatIoError :: Params ps => Format -> ps -> IO a@@ -45,21 +63,30 @@ Nothing -> formatIoError "locale is not set" () defaultUpstreamHost :: T.Text-defaultUpstreamHost = "msg.nicovideo.jp"+defaultUpstreamHost = "nmsg.nicovideo.jp" translateCmdArgs :: String -> Translator translateCmdArgs lang =- Translator { language = lang &= typ "LANG"- &= help "Target language to translate to [en]"+ Translator { language' = lang &= explicit+ &= name "language"+ &= name "lang"+ &= name "l"+ &= typ "LANG"+ &= help "Target language to translate to [en]" , port = 80 &= typ "PORT" &= help "Port number to listen [80]"+ , apiKey' = def &= argPos 0 &= typ "API_KEY" }+ &= program "nicovideo-translator"+ &= summary "Nico Nico Douga (ニコニコ動画) Comment Translator"+ &= details+ ["It takes a Google Translate API key as its first argument."] main :: IO () main = do currentLang <- catchIOError currentLanguage (\_ -> return L.EN) opts <- cmdArgs $ translateCmdArgs $ L.language currentLang- lang <- readLanguageCode $ language opts+ 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)@@ -68,13 +95,17 @@ \resolver -> lookupA resolver (encodeUtf8 defaultUpstreamHost) case resolution of Right (resolvedHost:_) ->- let upstreamHost = T.pack $ show resolvedHost+ let upstreamHost' = T.pack $ show resolvedHost in do hPutStrLn stdout $ T.concat ["Upstream: " , defaultUpstreamHost- , " (", upstreamHost, ")"+ , " (", upstreamHost', ")" ]- run portNum $ app (ProxyConfiguration lang upstreamHost)+ let conf = ProxyConfiguration { language = lang+ , upstreamHost = upstreamHost'+ , apiKey = T.pack $ apiKey' opts+ }+ run portNum $ app conf _ -> hPutStrLn stderr $ T.concat [ "error: failed to resolve " , defaultUpstreamHost ]
lib/NicovideoTranslator/Proxy.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE OverloadedStrings #-} module NicovideoTranslator.Proxy- ( ProxyConfiguration(ProxyConfiguration)+ ( ProxyConfiguration ( ProxyConfiguration+ , apiKey+ , language+ , upstreamHost+ ) , app- , language- , upstreamHost ) where import Data.List (find)@@ -29,11 +31,13 @@ def, elementNodes, parseLBS, renderLBS) import Text.XML.Cursor (content, element, fromDocument, node, ($//), (&//)) -import NicovideoTranslator.Translate (translateMultiple)+import NicovideoTranslator.Translate (ApiKey, translate) -data ProxyConfiguration = ProxyConfiguration { language :: ISO639_1- , upstreamHost :: Text- }+data ProxyConfiguration =+ ProxyConfiguration { language :: ISO639_1+ , upstreamHost :: Text+ , apiKey :: ApiKey+ } app :: ProxyConfiguration -> Application app config req respond =@@ -70,9 +74,17 @@ rHeaders = (response ^. responseHeaders) toBeTranslated = method == "POST" && mimetype == "text/xml" translated <- if toBeTranslated- then translateResponse (language config) rBody+ then translateResponse (apiKey config)+ (language config)+ rBody else return rBody- respond $ responseLBS rStatus rHeaders translated+ let headers = [ (name, value)+ | (name, value) <- rHeaders+ , name /= "content-length"+ ]+ -- Content-Length becomes invalid since the translated text doesn't+ -- have the same length to its source text+ respond $ responseLBS rStatus headers translated where method = requestMethod req headerList = requestHeaders req@@ -89,15 +101,15 @@ request "DELETE" = \options url _ -> deleteWith options url request _ = \_ _ _ -> ioError $ userError $ "unsupported method" -translateResponse :: ISO639_1 -> LB.ByteString -> IO LB.ByteString-translateResponse lang response = case parseLBS def response of+translateResponse :: ApiKey -> ISO639_1 -> LB.ByteString -> IO LB.ByteString+translateResponse apiKey' lang response = case parseLBS def response of Left _ -> return response- Right doc -> do translatedDoc <- translateXml lang doc+ Right doc -> do translatedDoc <- translateXml apiKey' lang doc return $ renderLBS def translatedDoc -translateXml :: ISO639_1 -> Document -> IO Document-translateXml lang doc = do- translatedTexts <- translateMultiple lang texts+translateXml :: ApiKey -> ISO639_1 -> Document -> IO Document+translateXml apiKey' lang doc = do+ translatedTexts <- translate apiKey' lang texts let translatedElems = [ (el, el { elementNodes = [NodeContent text] }) | (el, text) <- zip elems translatedTexts ] return $ transformXml doc translatedElems
lib/NicovideoTranslator/Translate.hs view
@@ -1,16 +1,57 @@-{-# LANGUAGE OverloadedStrings #-}-module NicovideoTranslator.Translate- (- translate- , translateMultiple- ) where+{-# LANGUAGE OverloadedLists, OverloadedStrings #-}+module NicovideoTranslator.Translate (ApiKey, translate) where -import qualified Language.Translate.Naver as Naver-import Data.LanguageCodes (ISO639_1(JA))-import Data.Text (Text)+import GHC.Exts (IsList (toList))+import Prelude hiding (lookup) -translate :: ISO639_1 -> Text -> IO Text-translate = Naver.translate JA+import Control.Concurrent.Async (concurrently)+import Control.Lens ((&), (.~), (^.))+import Data.Aeson.Types (Value (Array, Bool, Object, String), toJSON)+import Data.HashMap.Strict (lookup)+import Data.LanguageCodes (ISO639_1)+import Data.Text (Text, pack, toLower, unpack)+import Network.Wreq ( Options+ , Response+ , asJSON+ , defaults+ , param+ , postWith+ , responseBody+ ) -translateMultiple :: ISO639_1 -> [Text] -> IO [Text]-translateMultiple = Naver.translateMultiple JA+type ApiKey = Text++apiUrl :: String+apiUrl = "https://translation.googleapis.com/language/translate/v2"++translate :: ApiKey -> ISO639_1 -> [Text] -> IO [Text]+translate apiKey target texts =+ case splitAt 128 texts of+ ([], _) -> return []+ (head, []) -> translate' apiKey target head+ (head, tail) -> do+ let trans = translate apiKey target+ (headResult, tailResult) <- concurrently (trans head) (trans tail)+ return $ headResult ++ tailResult++translate' :: ApiKey -> ISO639_1 -> [Text] -> IO [Text]+translate' apiKey target texts = do+ response <- (asJSON =<< postWith query apiUrl params) :: IO (Response Value)+ let Object body = response ^. responseBody+ Just (Object data') = lookup "data" body+ Just (Array translations) = lookup "translations" data'+ return $ [ s+ | Object r <- toList translations+ , Just (String s) <- [lookup "translatedText" r]+ ]+ where+ query :: Options+ query = defaults & param "key" .~ [apiKey]+ params :: Value+ params = Object+ [ ("target", String $ toLower . pack . show $ target)+ , ("source", String "ja")+ , ("prettyprint", Bool False)+ , ("format", String "text")+ , ("q", toJSON texts)+ ]
nicovideo-translator.cabal view
@@ -1,49 +1,62 @@ name: nicovideo-translator-version: 0.1.0.1+version: 0.2.0.0 synopsis: Nico Nico Douga (ニコニコ動画) Comment Translator+description: Translate comments (written in Japanese) on+ Nico Nico Douga (ニコニコ動画) to your language.+ .+ See also README.md for more details. homepage: https://github.com/dahlia/nicovideo-translator bug-reports: https://github.com/dahlia/nicovideo-translator/issues license: AGPL-3 license-file: LICENSE author: Hong Minhee-maintainer: hongminhee@member.fsf.org-copyright: (c) 2015 Hong Minhee+maintainer: hong.minhee@gmail.com+copyright: (c) 2015–2016 Hong Minhee stability: alpha+category: Translation build-type: Simple extra-source-files: README.md cabal-version: >=1.10 +source-repository head+ type: git+ location: git://github.com/dahlia/nicovideo-translator.git+ library hs-source-dirs: lib exposed-modules: NicovideoTranslator.Main, NicovideoTranslator.Proxy, NicovideoTranslator.Translate- build-depends: base >=4.5.0.0 && <4.8.0.0,+ build-depends: aeson >=0.11.2.1 && <1.1.0.0,+ async >=2.1.0 && <2.2.0,+ base >=4.9.0.0 && <4.10.0.0, bytestring >=0.10.4.0 && <0.11.0.0, case-insensitive >=1.2.0.0 && <1.3.0.0, cmdargs >=0.10.12 && <0.11.0, containers,- dns >=1.4.4 && <1.5.0,+ dns >=2.0.0 && <2.1.0, http-client >=0.4.9 && <0.5.0,- http-types >=0.8.6 && <0.9.0,+ http-types >=0.9.0 && <0.10.0, iso639,- lens >=4.8 && <4.9,- naver-translate >=0.1.0.0 && <0.2.0.0,+ lens >=4.14 && <4.15,+ lens-aeson >=1.0.0.5 && <1.1.0.0, setlocale >=1.0.0.2 && <1.1.0.0,- text >=1.1.0.0 && <1.2.0.0,+ text >=1.1.0.0 && <1.3.0.0, text-format >=0.3.1.1 && <0.4.0.0,- wai >=3.0.2.3 && <3.1.0.0,- warp >=3.0.10 && <3.1.0,- wreq >=0.3.0.1 && <0.4.0.0,- xml-conduit >=1.2.3.3 && <1.3.0.0+ unordered-containers,+ wai >=3.2.1.1 && <3.3.0.0,+ warp >=3.2.8 && <3.3.0,+ wreq >=0.4.1.0 && <0.5.0.0,+ xml-conduit >=1.3.5 && <1.4.0 default-language: Haskell2010- ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded+ ghc-options: -Wall -fwarn-incomplete-uni-patterns executable nicovideo-translator hs-source-dirs: src main-is: Main.hs- build-depends: base >=4.5.0.0 && <4.8.0.0,+ build-depends: base >=4.9.0.0 && <4.10.0.0, nicovideo-translator default-language: Haskell2010- ghc-options: -Wall -fwarn-incomplete-uni-patterns -threaded+ ghc-options: -Wall -fwarn-incomplete-uni-patterns+ -threaded -with-rtsopts=-N