diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -0,0 +1,8 @@ +# 2010.01.24 Joao F. Ferreira + + - Added support for language detection: `Text.Language.Detect` + - `Text.Translate` is now `Text.Language.Translate`, but I've maintained + `Text.Translate` for backward compatibility + - Fixed bug with URI escaping. Google's API is expecting an ASCII string + that is first escaped with UTF-8. + - Refactored parts of the module to avoid repeated code diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1,15 +1,18 @@ Translate ========== -Haskell binding to Google translate +Haskell binding to Google's AJAX Language API for Translation and Detection ghci - > :m Text.Translate + > :m Text.Language.Translate > translate "en" "fr" "hello" Just "bonjour" + > :m Text.Language.Detect + > detect "Program testing can be used to show the presence of bugs, but never to show their absence!" + Just ("en",True,0.87355334) diff --git a/src/Text/Language/Detect.hs b/src/Text/Language/Detect.hs new file mode 100644 --- /dev/null +++ b/src/Text/Language/Detect.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Text.Language.Detect (detect,detectCode) where + +import Text.Language.Internals +import Text.JSON.Generic +import Prelude hiding ((.), (-)) + +-- http://ajax.googleapis.com/ajax/services/language/detect?v=1.0&q=Hello+World + +{- +{"responseData"=>{"language"=>"en","isReliable"=>false,"confidence"=>0.114892714}, + "responseStatus"=>200, + "responseDetails"=>nil} +-} + +-- Datatypes +data RText = RText + { + language :: String, + isReliable :: Bool, + confidence :: Double + } + deriving (Eq, Show, Data, Typeable) + +data RGood = RGood + { + responseData :: RText + } + deriving (Eq, Show, Data, Typeable) + + +base_url :: String +base_url = "http://ajax.googleapis.com/ajax/services/language/detect" + +detect_api :: String -> String +detect_api what = google_api base_url [("v", "1.0"), ("q", what)] + +-- | Returns the language code associated with the given text +detectCode :: String -> IO (Maybe String) +detectCode what = do + r <- curl - detect_api what + case r of + Nothing -> return - Nothing + Just x -> + let status = x.decodeJSON + in + if status.responseStatus == 200 + then do + let rgood = x.decodeJSON + return - Just - rgood.responseData.language + else do + return Nothing + +-- | Returns a triple where the first component is the language code associated with +-- given text, the second is a boolean representing whether or not the detection interval +-- believes the language code is reliable for the given text, and the third is a +-- numeric value between 0-1.0 that represents the confidence level in the language code +-- for the given text. +detect :: String -> IO (Maybe (String,Bool,Double)) +detect what = do + r <- curl - detect_api what + case r of + Nothing -> return - Nothing + Just x -> + let status = x.decodeJSON + in + if status.responseStatus == 200 + then do + let rgood = x.decodeJSON + return - Just - (rgood.responseData.language, + rgood.responseData.isReliable, + rgood.responseData.confidence) + else do + return Nothing diff --git a/src/Text/Language/Internals.hs b/src/Text/Language/Internals.hs new file mode 100644 --- /dev/null +++ b/src/Text/Language/Internals.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Text.Language.Internals where + +import Text.JSON.Generic +import Network.Curl +import qualified Data.List as L +import Prelude hiding ((.), (-)) +import Network.URI (isAllowedInURI) +import qualified Codec.Binary.UTF8.String as Utf +import Numeric + +-- This module factors out auxiliar and similar functions to the Text.Language modules + +-- Datatypes +data RStatus = RStatus + { + responseStatus :: Integer + } + deriving (Eq, Show, Data, Typeable) + + +data RBad = RBad + { + responseDetails :: String + } + deriving (Eq, Show, Data, Typeable) + + +-- | Perform a request using Network.Curl +-- +curl :: String -> IO (Maybe String) +curl x = do + (r, s) <- curlGetString x [] + if r == CurlOK + then return - Just s + else return Nothing + +-- | Constructs a string with the given arguments ready to be sent +-- to Google's APIs +google_api :: String -> [(String,String)] -> String +google_api base_url args = + let make_pair (x, y) = x ++ "=" ++ escape_uri y + in + base_url ++ "?" ++ args .map make_pair .join "&" + + + +-- bolerplate + +-- base DSL +{-# INLINE (.) #-} +(.) :: a -> (a -> b) -> b +a . f = f a +infixl 9 . + +{-# INLINE (-) #-} +(-) :: (a -> b) -> a -> b +f - x = f x +infixr 0 - + +join :: [a] -> [[a]] -> [a] +join = L.intercalate + + + +-- Google APIs encode text as ASCII, but it is first escaped with UTF-8. +-- Therefore, the |escapeURIString| function in Network.URI cannot be used. +-- We redefine it here. + +-- | Can be used to validate the URI sent to Google's API +-- +escape_uri :: String -> String +escape_uri = escapeURIString isAllowedInURI + +-- | Escapes a special character with UTF-8. +-- +escapeURIChar :: (Char->Bool) -> Char -> String +escapeURIChar p c + | p c = [c] + | otherwise = concatMap ('%':) $ map (flip showHex "") $ Utf.encode [c] + +-- | Can be used to make a string valid for use in a URI. +-- +escapeURIString + :: (Char->Bool) -- ^ a predicate which returns 'False' + -- if the character should be escaped + -> String -- ^ the string to process + -> String -- ^ the resulting URI string +escapeURIString p s = concatMap (escapeURIChar p) s diff --git a/src/Text/Language/Translate.hs b/src/Text/Language/Translate.hs new file mode 100644 --- /dev/null +++ b/src/Text/Language/Translate.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE DeriveDataTypeable #-} + +module Text.Language.Translate (translate) where + +import Text.Language.Internals + +import Text.JSON.Generic +import Prelude hiding ((.), (-)) + +-- http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&langpair=en|de&q=Hello+World + +{- +{"responseData"=>{"translatedText"=>"Hallo Welt"}, + "responseStatus"=>200, + "responseDetails"=>nil} +-} + +-- Datatypes +data RText = RText + { + translatedText :: String + } + deriving (Eq, Show, Data, Typeable) + +data RGood = RGood + { + responseData :: RText + } + deriving (Eq, Show, Data, Typeable) + + +base_url :: String +base_url = "http://ajax.googleapis.com/ajax/services/language/translate" + +trans_api :: String -> String -> String -> String +trans_api from to what = google_api base_url [("v", "1.0"), ("langpair", from ++ "|" ++ to), ("q", what)] + +translate :: String -> String -> String -> IO (Maybe String) +translate from to what = do + r <- curl - trans_api from to what + case r of + Nothing -> return - Nothing + Just x -> + let status = x.decodeJSON + in + if status.responseStatus == 200 + then do + let rgood = x.decodeJSON + return - Just - rgood.responseData.translatedText + else do + return Nothing diff --git a/src/Text/Translate.hs b/src/Text/Translate.hs --- a/src/Text/Translate.hs +++ b/src/Text/Translate.hs @@ -2,92 +2,7 @@ module Text.Translate (translate) where -import Text.JSON.Generic -import Network.Curl -import qualified Data.List as L -import Prelude hiding ((.), (-)) -import Network.URI - --- http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&langpair=en|de&q=Hello+World - -{- -{"responseData"=>{"translatedText"=>"Hallo Welt"}, - "responseStatus"=>200, - "responseDetails"=>nil} --} - -curl :: String -> IO (Maybe String) -curl x = do - (r, s) <- curlGetString x [] - if r == CurlOK - then return - Just s - else return Nothing - -base_url :: String -base_url = "http://ajax.googleapis.com/ajax/services/language/translate" - -trans_api :: String -> String -> String -> String -trans_api from to what = - let make_pair (x, y) = x ++ "=" ++ escape_uri y - in - base_url ++ "?" ++ [("v", "1.0"), ("langpair", from ++ "|" ++ to), ("q", what)] .map make_pair .join "&" - -data RStatus = RStatus - { - responseStatus :: Integer - } - deriving (Eq, Show, Data, Typeable) - -data RText = RText - { - translatedText :: String - } - deriving (Eq, Show, Data, Typeable) - -data RGood = RGood - { - responseData :: RText - } - deriving (Eq, Show, Data, Typeable) - -data RBad = RBad - { - responseDetails :: String - } - deriving (Eq, Show, Data, Typeable) - -translate :: String -> String -> String -> IO (Maybe String) -translate from to what = do - r <- curl - trans_api from to what - case r of - Nothing -> return - Nothing - Just x -> - let status = x.decodeJSON - in - if status.responseStatus == 200 - then do - let rgood = x.decodeJSON - return - Just - rgood.responseData.translatedText - else do - return Nothing - - --- bolerplate - - --- base DSL -{-# INLINE (.) #-} -(.) :: a -> (a -> b) -> b -a . f = f a -infixl 9 . - -{-# INLINE (-) #-} -(-) :: (a -> b) -> a -> b -f - x = f x -infixr 0 - - -join :: [a] -> [[a]] -> [a] -join = L.intercalate +-- This module is just a wrapper to Text.Language.Translate +-- It exists for backward compatibility. -escape_uri :: String -> String -escape_uri = escapeURIString isAllowedInURI +import Text.Language.Translate (translate) diff --git a/translate.cabal b/translate.cabal --- a/translate.cabal +++ b/translate.cabal @@ -1,24 +1,26 @@ Name: translate -Version: 2009.12.17 +Version: 2010.1.24 Build-type: Simple -Synopsis: Haskell binding to Google translate -Description: translate "en" "fr" "hello" - +Synopsis: Haskell binding to Google's AJAX Language API for Translation and Detection +Description: Haskell binding to Google's AJAX Language API for Translation and Detection. License: BSD3 License-file: LICENSE -Author: Wang, Jinjing -Maintainer: Wang, Jinjing +Author: Joao F. Ferreira , Jinjing Wang +Maintainer: Jinjing Wang Build-Depends: base Cabal-version: >= 1.2 -category: Codec +category: Text homepage: http://github.com/nfjinjing/translate data-files: readme.md, changelog.md library ghc-options: -Wall - build-depends: base >= 4 && < 5, curl, json, network + build-depends: base >= 4 && < 5, curl, json, network, utf8-string hs-source-dirs: src/ exposed-modules: Text.Translate + Text.Language.Translate + Text.Language.Detect + Text.Language.Internals