Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

add source and update cabal

  • Loading branch information...
commit 51f0274bc2a5b46f386ffbcb4684336319ea4b70 1 parent 8dec383
Jinjing Wang authored January 25, 2010
75  src/Text/Language/Detect.hs
... ...
@@ -0,0 +1,75 @@
  1
+{-# LANGUAGE DeriveDataTypeable #-}
  2
+
  3
+module Text.Language.Detect (detect,detectCode) where
  4
+
  5
+import Text.Language.Internals
  6
+import Text.JSON.Generic 
  7
+import Prelude hiding ((.), (-))
  8
+
  9
+-- http://ajax.googleapis.com/ajax/services/language/detect?v=1.0&q=Hello+World
  10
+
  11
+{-
  12
+{"responseData"=>{"language"=>"en","isReliable"=>false,"confidence"=>0.114892714},
  13
+ "responseStatus"=>200,
  14
+ "responseDetails"=>nil}
  15
+-}
  16
+
  17
+-- Datatypes
  18
+data RText = RText
  19
+  {
  20
+    language   :: String,
  21
+    isReliable :: Bool,
  22
+    confidence :: Double
  23
+  }
  24
+  deriving (Eq, Show, Data, Typeable)
  25
+
  26
+data RGood = RGood
  27
+  {
  28
+    responseData :: RText
  29
+  }
  30
+  deriving (Eq, Show, Data, Typeable)
  31
+ 
  32
+
  33
+base_url :: String
  34
+base_url = "http://ajax.googleapis.com/ajax/services/language/detect"
  35
+
  36
+detect_api :: String -> String
  37
+detect_api what = google_api base_url [("v", "1.0"), ("q", what)] 
  38
+    
  39
+-- | Returns the language code associated with the given text
  40
+detectCode :: String -> IO (Maybe String)
  41
+detectCode what = do
  42
+  r <- curl - detect_api what
  43
+  case r of
  44
+    Nothing -> return - Nothing
  45
+    Just x -> 
  46
+      let status = x.decodeJSON
  47
+      in
  48
+      if status.responseStatus == 200
  49
+        then do
  50
+          let rgood = x.decodeJSON
  51
+          return - Just - rgood.responseData.language
  52
+        else do
  53
+          return Nothing
  54
+
  55
+-- | Returns a triple where the first component is the language code associated with
  56
+--   given text, the second is a boolean representing whether or not the detection interval 
  57
+--   believes the language code is reliable for the given text, and the third is a
  58
+--   numeric value between 0-1.0 that represents the confidence level in the language code
  59
+--   for the given text.
  60
+detect :: String -> IO (Maybe (String,Bool,Double))
  61
+detect what = do
  62
+  r <- curl - detect_api what
  63
+  case r of
  64
+    Nothing -> return - Nothing
  65
+    Just x -> 
  66
+      let status = x.decodeJSON
  67
+      in
  68
+      if status.responseStatus == 200
  69
+        then do
  70
+          let rgood = x.decodeJSON
  71
+          return - Just - (rgood.responseData.language,
  72
+                           rgood.responseData.isReliable,
  73
+                           rgood.responseData.confidence)
  74
+        else do
  75
+          return Nothing
90  src/Text/Language/Internals.hs
... ...
@@ -0,0 +1,90 @@
  1
+{-# LANGUAGE DeriveDataTypeable #-}
  2
+
  3
+module Text.Language.Internals where
  4
+
  5
+import Text.JSON.Generic
  6
+import Network.Curl
  7
+import qualified Data.List as L
  8
+import Prelude hiding ((.), (-))
  9
+import Network.URI (isAllowedInURI)
  10
+import qualified Codec.Binary.UTF8.String as Utf
  11
+import Numeric
  12
+
  13
+-- This module factors out auxiliar and similar functions to the Text.Language modules
  14
+
  15
+-- Datatypes
  16
+data RStatus = RStatus
  17
+  {
  18
+    responseStatus :: Integer
  19
+  }
  20
+  deriving (Eq, Show, Data, Typeable)
  21
+
  22
+   
  23
+data RBad = RBad
  24
+  {
  25
+    responseDetails :: String
  26
+  }
  27
+  deriving (Eq, Show, Data, Typeable)
  28
+
  29
+
  30
+-- | Perform a request using Network.Curl
  31
+--
  32
+curl :: String -> IO (Maybe String)
  33
+curl x = do
  34
+  (r, s) <- curlGetString x []
  35
+  if r == CurlOK
  36
+    then return - Just s
  37
+    else return Nothing
  38
+
  39
+-- | Constructs a string with the given arguments ready to be sent
  40
+--   to Google's APIs
  41
+google_api :: String -> [(String,String)] -> String
  42
+google_api base_url args = 
  43
+  let make_pair (x, y) = x ++ "=" ++ escape_uri y
  44
+  in
  45
+  base_url ++ "?" ++  args .map make_pair .join "&"
  46
+ 
  47
+
  48
+
  49
+-- bolerplate
  50
+
  51
+-- base DSL
  52
+{-# INLINE (.) #-}
  53
+(.) :: a -> (a -> b) -> b
  54
+a . f = f a
  55
+infixl 9 .
  56
+
  57
+{-# INLINE (-) #-}
  58
+(-) :: (a -> b) -> a -> b
  59
+f - x =  f x
  60
+infixr 0 - 
  61
+
  62
+join :: [a] -> [[a]] -> [a]
  63
+join = L.intercalate
  64
+
  65
+
  66
+
  67
+-- Google APIs encode text as ASCII, but it is first escaped with UTF-8.
  68
+-- Therefore, the |escapeURIString| function in Network.URI cannot be used. 
  69
+-- We redefine it here.
  70
+
  71
+-- | Can be used to validate the URI sent to Google's API
  72
+--
  73
+escape_uri :: String -> String
  74
+escape_uri = escapeURIString isAllowedInURI
  75
+
  76
+-- | Escapes a special character with UTF-8.
  77
+--
  78
+escapeURIChar :: (Char->Bool) -> Char -> String
  79
+escapeURIChar p c
  80
+    | p c       = [c]
  81
+    | otherwise = concatMap ('%':) $ map (flip showHex "") $ Utf.encode [c]
  82
+
  83
+-- | Can be used to make a string valid for use in a URI.
  84
+--
  85
+escapeURIString
  86
+    :: (Char->Bool)     -- ^ a predicate which returns 'False'
  87
+                        --   if the character should be escaped
  88
+    -> String           -- ^ the string to process
  89
+    -> String           -- ^ the resulting URI string
  90
+escapeURIString p s = concatMap (escapeURIChar p) s
51  src/Text/Language/Translate.hs
... ...
@@ -0,0 +1,51 @@
  1
+{-# LANGUAGE DeriveDataTypeable #-}
  2
+
  3
+module Text.Language.Translate (translate) where
  4
+
  5
+import Text.Language.Internals
  6
+
  7
+import Text.JSON.Generic
  8
+import Prelude hiding ((.), (-))
  9
+
  10
+-- http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&langpair=en|de&q=Hello+World
  11
+
  12
+{-
  13
+{"responseData"=>{"translatedText"=>"Hallo Welt"},
  14
+ "responseStatus"=>200,
  15
+ "responseDetails"=>nil}
  16
+-}
  17
+
  18
+-- Datatypes
  19
+data RText = RText
  20
+  {
  21
+    translatedText :: String
  22
+  }
  23
+  deriving (Eq, Show, Data, Typeable)
  24
+
  25
+data RGood = RGood
  26
+  {
  27
+    responseData :: RText
  28
+  }
  29
+  deriving (Eq, Show, Data, Typeable)
  30
+ 
  31
+
  32
+base_url :: String
  33
+base_url = "http://ajax.googleapis.com/ajax/services/language/translate"
  34
+
  35
+trans_api :: String -> String -> String -> String
  36
+trans_api from to what = google_api base_url [("v", "1.0"), ("langpair", from ++ "|" ++ to), ("q", what)]
  37
+
  38
+translate :: String -> String -> String -> IO (Maybe String)
  39
+translate from to what = do
  40
+  r <- curl - trans_api from to what
  41
+  case r of
  42
+    Nothing -> return - Nothing
  43
+    Just x -> 
  44
+      let status = x.decodeJSON
  45
+      in
  46
+      if status.responseStatus == 200
  47
+        then do
  48
+          let rgood = x.decodeJSON
  49
+          return - Just - rgood.responseData.translatedText
  50
+        else do
  51
+          return Nothing
4  translate.cabal
@@ -7,8 +7,8 @@ Description:          Haskell binding to Google's AJAX Language API for Translat
7 7
 
8 8
 License:              BSD3
9 9
 License-file:         LICENSE
10  
-Author:               Wang, Jinjing
11  
-Maintainer:           Wang, Jinjing <nfjinjing@gmail.com>
  10
+Author:               Jinjing Wang <nfjinjing@gmail.com>, Joao F. Ferreira  <joao@joaoff.com>
  11
+Maintainer:           Jinjing Wang <nfjinjing@gmail.com>
12 12
 Build-Depends:        base
13 13
 Cabal-version:        >= 1.2
14 14
 category:             Text

0 notes on commit 51f0274

Please sign in to comment.
Something went wrong with that request. Please try again.