naver-translate 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+52/−16 lines, 2 filesdep +network-uri

Dependencies added: network-uri

Files

• naver-translate.cabal +10/−8
• src/Language/Translate/Naver.hs +42/−8

@@ -1,7 +1,8 @@ name:                naver-translate-version:             0.1.0.0+version:             0.1.0.1 synopsis:            Interface to Naver Translate homepage:            https://github.com/dahlia/naver-translate+bug-reports:         https://github.com/dahlia/naver-translate/issues license:             GPL-3 license-file:        LICENSE author:              Hong Minhee@@ -14,13 +15,14 @@  library   exposed-modules:     Language.Translate.Naver-  build-depends:       aeson       >=0.7.0.6  && <0.8.0.0,-                       base        >=4.7 && <4.8,+  build-depends:       aeson        >=0.7.0.6  && <0.8.0.0,+                       base         >=4.7 && <4.8,                        iso639,-                       lens        >=4.8 && <4.9,-                       lens-aeson  >=1.0.0.3  && <1.1.0.0,-                       text        >=1.1.0.0  && <1.2.0.0,-                       wreq        >=0.3.0.1  && <0.4.0.0,-                       random      >=1.0.1.1  && <1.1.0.0+                       lens         >=4.8 && <4.9,+                       lens-aeson   >=1.0.0.3  && <1.1.0.0,+                       network-uri  >=2.6.0.0  && <3.0.0.0,+                       text         >=1.1.0.0  && <1.2.0.0,+                       wreq         >=0.3.0.1  && <0.4.0.0,+                       random       >=1.0.1.1  && <1.1.0.0   hs-source-dirs:      src   default-language:    Haskell2010

@@ -1,28 +1,35 @@ {-# LANGUAGE OverloadedStrings #-} module Language.Translate.Naver ( translate                                 , translateMultiple+                                , translateUrl                                 ) where  import Control.Lens ((^?))+import Control.Monad (liftM) import Data.Aeson.Lens (key) import Data.Aeson.Types (Value(String))-import Data.LanguageCodes (ISO639_1, language)+import Data.LanguageCodes (ISO639_1(JA, KO), language) import Data.Text (Text, cons, intercalate, pack, snoc, splitOn, strip)+import Network.URI (URI(URI), URIAuth(URIAuth), relativeTo, uriIsAbsolute) import Network.Wreq (FormParam((:=)), post, responseBody) import System.Random (getStdRandom, randomR) -translate :: ISO639_1 -> ISO639_1 -> Text -> IO Text+-- | Translate a string.+translate :: ISO639_1 -- ^ The language translated from+          -> ISO639_1 -- ^ The language to translate to+          -> Text     -- ^ The text to translate+          -> IO Text  -- ^ The translated text translate sourceLanguage targetLanguage text =     let response =             post             "http://translate.naver.com/translate.dic"             [ "query" := text-            , "srcLang" := (pack $ language sourceLanguage)-            , "tarLang" := (pack $ language targetLanguage)+            , "srcLang" := pack (language sourceLanguage)+            , "tarLang" := pack (language targetLanguage)             , "highlight" := ("0" :: Text)             , "hurigana" := ("0" :: Text)]         getResultData resp = resp ^? responseBody . key "resultData"-        resultData = response >>= return . getResultData+        resultData = liftM getResultData response     in         resultData >>= \dat -> case dat of             Just (String translated) -> return translated@@ -35,13 +42,40 @@ arbitraryNumeric =     let         randomDigit i = getStdRandom (randomR (if i > 1 then '0' else '1', '9'))-        string = sequence $ map randomDigit [1..arbitraryNumericLength]+        string = mapM randomDigit [1..arbitraryNumericLength]     in-        string >>= return . pack+        liftM pack string -translateMultiple :: ISO639_1 -> ISO639_1 -> [Text] -> IO [Text]+-- | Translate multiple strings at one go.+translateMultiple :: ISO639_1  -- ^ The language translated from+                  -> ISO639_1  -- ^ The language to translate to+                  -> [Text]    -- ^ The texts to translate+                  -> IO [Text] -- ^ The translated texts translateMultiple sourceLanguage targetLanguage texts = do     spliter <- arbitraryNumeric     let bundle = intercalate (snoc (cons ' ' spliter) ' ') texts     result <- translate sourceLanguage targetLanguage bundle     return $ map strip $ splitOn spliter result++-- | Get the url of the translated page.  Other languages than Korean+-- ('KO') and Japanese ('JA') are unsupported, so they get 'Nothing'.+translateUrl :: ISO639_1  -- ^ The language translated from+             -> ISO639_1  -- ^ The language to translate to+             -> URI       -- ^ The url of the page to translate+             -> Maybe URI -- ^ The url of the translated page+translateUrl sourceLanguage targetLanguage (URI scheme authority path query _) =+    case (scheme, authority) of+        ("http:", Just (URIAuth "" host port)) ->+            let relUrl = getRelUrl host port+                getUrl = Just . relativeTo relUrl+            in case langPair of+                (JA, KO) -> getUrl j2k+                (KO, JA) -> getUrl k2j+                _ -> Nothing+        _ -> Nothing+  where+    langPair = (sourceLanguage, targetLanguage)+    baseAuth = Just $ URIAuth "" "jptrans.naver.net" ""+    j2k = URI "http:" baseAuth "/j2k_frame.php/korean/" "" ""+    k2j = URI "http:" baseAuth "/webtrans.php/korean/" "" ""+    getRelUrl host port = URI "" Nothing (host ++ port ++ path) query ""