module Language.Translate.Google (
Language (..),
translate,
languageMap
) where
import Data.Map (Map)
import Data.Text (Text)
import Network.Curl.Download
import Text.JSON
import qualified Codec.Binary.Url as C
import qualified Data.ByteString as B
import qualified Data.Map as M
import qualified Data.Text as T
data Language =
Afrikaans
| Albanian
| Amharic
| Arabic
| Armenian
| Azerbaijani
| Basque
| Belarusian
| Bengali
| Bihari
| Bulgarian
| Burmese
| Catalan
| Cherokee
| Chinese
| ChineseSimplified
| ChineseTraditional
| Croatian
| Czech
| Danish
| Dhivehi
| Dutch
| English
| Esperanto
| Estonian
| Filipino
| Finnish
| French
| Galician
| Georgian
| German
| Greek
| Guarani
| Gujarati
| Hebrew
| Hindi
| Hungarian
| Icelandic
| Indonesian
| Inuktitut
| Italian
| Japanese
| Kannada
| Kazakh
| Khmer
| Korean
| Kurdish
| Kyrgyz
| Laothian
| Latvian
| Lithuanian
| Macedonian
| Malay
| Malayalam
| Maltese
| Marathi
| Mongolian
| Nepali
| Norwegian
| Oriya
| Pashto
| Persian
| Polish
| Portuguese
| Punjabi
| Romanian
| Russian
| Sanskrit
| Serbian
| Sindhi
| Sinhalese
| Slovak
| Slovenian
| Spanish
| Swahili
| Swedish
| Tajik
| Tamil
| Tagalog
| Telugu
| Thai
| Tibetan
| Turkish
| Ukrainian
| Urdu
| Uzbek
| Uighur
| Vietnamese
| Unknown
deriving (Show, Eq, Ord, Read)
languageMap :: Map Language String
languageMap =
M.fromList
[(Afrikaans, "af")
,(Albanian, "sq")
,(Amharic, "am")
,(Arabic, "ar")
,(Armenian, "hy")
,(Azerbaijani, "az")
,(Basque, "eu")
,(Belarusian, "be")
,(Bengali, "bn")
,(Bihari, "bh")
,(Bulgarian, "bg")
,(Burmese, "my")
,(Catalan, "ca")
,(Cherokee, "chr")
,(Chinese, "zh")
,(ChineseSimplified, "zh-CN")
,(ChineseTraditional, "zh-TW")
,(Croatian, "hr")
,(Czech, "cs")
,(Danish, "da")
,(Dhivehi, "dv")
,(Dutch, "nl")
,(English, "en")
,(Esperanto, "eo")
,(Estonian, "et")
,(Filipino, "tl")
,(Finnish, "fi")
,(French, "fr")
,(Galician, "gl")
,(Georgian, "ka")
,(German, "de")
,(Greek, "el")
,(Guarani, "gn")
,(Gujarati, "gu")
,(Hebrew, "iw")
,(Hindi, "hi")
,(Hungarian, "hu")
,(Icelandic, "is")
,(Indonesian, "id")
,(Inuktitut, "iu")
,(Italian, "it")
,(Japanese, "ja")
,(Kannada, "kn")
,(Kazakh, "kk")
,(Khmer, "km")
,(Korean, "ko")
,(Kurdish, "ku")
,(Kyrgyz, "ky")
,(Laothian, "lo")
,(Latvian, "lv")
,(Lithuanian, "lt")
,(Macedonian, "mk")
,(Malay, "ms")
,(Malayalam, "ml")
,(Maltese, "mt")
,(Marathi, "mr")
,(Mongolian, "mn")
,(Nepali, "ne")
,(Norwegian, "no")
,(Oriya, "or")
,(Pashto, "ps")
,(Persian, "fa")
,(Polish, "pl")
,(Portuguese, "pt-PT")
,(Punjabi, "pa")
,(Romanian, "ro")
,(Russian, "ru")
,(Sanskrit, "sa")
,(Serbian, "sr")
,(Sindhi, "sd")
,(Sinhalese, "si")
,(Slovak, "sk")
,(Slovenian, "sl")
,(Spanish, "es")
,(Swahili, "sw")
,(Swedish, "sv")
,(Tajik, "tg")
,(Tamil, "ta")
,(Tagalog, "tl")
,(Telugu, "te")
,(Thai, "th")
,(Tibetan, "bo")
,(Turkish, "tr")
,(Ukrainian, "uk")
,(Urdu, "ur")
,(Uzbek, "uz")
,(Uighur, "ug")
,(Vietnamese, "vi")
,(Unknown, "")]
translate :: B.ByteString
-> Maybe Language
-> Language
-> IO (Either String Text)
translate text srcLang destLang = do
let getLangStr :: Language -> String
getLangStr lang
| M.null newMap
= error $ "Miss match language : " ++ show lang
| otherwise
= snd $ M.findMin newMap
where newMap = M.filterWithKey (\ l _ -> l == lang) languageMap
let url = "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0"
++ ("&q=" ++ C.encode (B.unpack text))
++ ("&langpair="
++ (maybe "" getLangStr srcLang
++ "|"
++ getLangStr destLang))
string <- openURIString url
return $
case string of
Left error -> Left error
Right jsonString ->
case decode jsonString of
Ok ((valFromObj "responseData") -> Ok ((valFromObj "translatedText") -> Ok tr)) ->
Right $ T.pack $ fromJSString tr
Error error -> Left error