packages feed

MicrosoftTranslator (empty) → 0.1.0.0

raw patch · 4 files changed

+296/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, datetime, exceptions, http-client, lens, text, transformers, url, wreq, xml

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Ernesto Rodriguez++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Ernesto Rodriguez nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ MicrosoftTranslator.cabal view
@@ -0,0 +1,50 @@+-- Initial BingTranslate.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                MicrosoftTranslator+version:             0.1.0.0+synopsis:            Interface for Microsoft Translator+description:+  A simple library to use Microsoft Translator+  (<https://www.microsoft.com/en-us/translator/default.aspx>) in Haskell.+  It provides an easy to use interface to the free translation service from+  Microsoft so one can easily add language translation to a Haskell program+  as long as there is internet connection available.+  +  The easiest way to use the program is via the toplevel translate function:+  > translate :: ClientId -> ClientSecret -> Text -> BingLanguage -> BingLanguage -> IO (Either BingError Text)++ To use this library one must have an account for Microsoft Translator in the+ Azure Data Market. More information about this package available at: (<https://github.com/netogallo/Microsoft-Translator-Haskell>).++license:             BSD3+license-file:        LICENSE+author:              Ernesto Rodriguez+maintainer:          neto@netowork.me+-- copyright:           +category:            Language+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10+source-repository head+  type: git+  location: https://github.com/netogallo/Microsoft-Translator-Haskell.git++library+  exposed-modules:     Language.Bing+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.8 && <4.9+                     , wreq >= 0.4.0.0+                     , bytestring >= 0.10.0+                     , exceptions >= 0.8.0+                     , lens >= 4.12.0+                     , transformers >= 0.4.3.0+                     , http-client >= 0.4.16+                     , aeson >= 0.9.0+                     , datetime >= 0.2.1+                     , text >= 1.2.0+                     , url >= 2.1.0+                     , xml >= 1.3.0+  hs-source-dirs:      src+  default-language:    Haskell2010
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Language/Bing.hs view
@@ -0,0 +1,214 @@+{-# Language RecordWildCards, OverloadedStrings, DeriveDataTypeable #-}+module Language.Bing(+  BingLanguage(..),+  BingError(..),+  ClientId,+  ClientSecret,+  checkToken,+  evalBing,+  getAccessToken,+  runBing,+  translate,+  translateM) where++import qualified Network.Wreq as N+import Network.Wreq.Types (Postable)+import Control.Lens+import Data.ByteString (ByteString)+import Data.ByteString.Char8 (pack,unpack)+import Control.Monad.Catch+import Data.Typeable (Typeable)+import Control.Monad.IO.Class+import Network.HTTP.Client (HttpException)+import qualified Control.Exception as E+import Control.Monad.Trans.Except+import Control.Monad.Trans.Class+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BLC+import Data.Aeson+import Control.Monad (mzero)+import Control.Applicative ((<$>),(<*>))+import Data.Monoid+import Control.Applicative+import Data.DateTime+import Data.Text (Text)+import qualified Data.Text as T+import Network.URL (decString)+import Text.XML.Light.Input+import Text.XML.Light.Types+import Text.XML.Light.Proc+import Data.List (find)+import qualified Data.Text.Encoding as TE+import qualified Data.Text.IO as TIO+import System.IO.Unsafe (unsafePerformIO)++type ClientId = ByteString++type ClientSecret = ByteString++data BingError = BingError ByteString+                 deriving (Typeable, Show)++-- | The languages available for Microsoft Translatorj+data BingLanguage = English+                  | German+                  | Norwegian+                  | Spanish++-- | Conversion function from Language to language code+toSym bl = case bl of+  English -> "en"+  German -> "de"+  Norwegian -> "no"+  Spanish -> "es"++data AccessToken = AccessToken {+  tokenType :: ByteString,+  token :: ByteString,+  expires :: Integer,+  scope :: ByteString+  } deriving Show++data BingContext = BCTX {+  accessToken :: AccessToken,+  inception :: DateTime,+  clientId :: ByteString,+  clientSecret :: ByteString+  } deriving Show++newtype BingMonad a = BM {runBing :: BingContext -> ExceptT BingError IO a}++instance Monad BingMonad where+  m >>= f = BM (\ctx' -> do+                   ctx <- checkToken ctx'+                   res <- runBing m ctx+                   runBing (f res) ctx)+            +  return a = BM $ \ctx -> return a++instance Functor BingMonad where+  fmap f bm = do+    v <- bm+    return $ f v++instance Applicative BingMonad where+  pure a = return a+  a <*> b = do+    a' <- a+    b' <- b+    return (a' b')++instance FromJSON AccessToken where+  parseJSON (Object v) = build <$>+                         v .: "token_type" <*>+                         v .: "access_token" <*>+                         ((v .: "expires_in") >>= getNum) <*>+                         v .: "scope"+    +    where+      getNum str = case decode (BLC.pack str) of+        Just n -> return n+        Nothing -> mzero+      build :: String -> String -> Integer -> String -> AccessToken+      build v1 v2 v3 v4 = AccessToken (pack v1) (pack v2) v3 (pack v4)+  parseJSON _ = mzero++instance Exception BingError++scopeArg = ("scope" :: ByteString)+        N.:= ("http://api.microsofttranslator.com" :: ByteString)++grantType = ("grant_type" :: ByteString)+            N.:= ("client_credentials" :: ByteString)++tokenAuthPage :: String+tokenAuthPage = "https://datamarket.accesscontrol.windows.net/v2/OAuth2-13"++translateUrl :: String+translateUrl = "http://api.microsofttranslator.com/v2/Http.svc/Translate"+-- translateUrl = "http://requestb.in/14zmco81"+ +translateArgs text from to = [+  ("text" N.:= (text :: ByteString)),+  ("from" N.:= (toSym from :: ByteString)),+  ("to" N.:= (toSym to :: ByteString))+  ]++bingAction :: IO (N.Response BL.ByteString) -> ExceptT BingError IO (N.Response BL.ByteString)+bingAction action = do+  res <- lift $ (E.try action :: IO (Either HttpException (N.Response BL.ByteString)))+  case res of+    Right res -> return res+    Left ex -> throwE $ BingError $ pack $ show ex++post url postable = bingAction (N.post url postable) ++postWith opts url postable = bingAction (N.postWith opts url postable)++getWithAuth opts' url = withContext $ \BCTX{..} -> do+  let opts = opts' & N.header "Authorization" .~ ["Bearer " <> token accessToken]+  bingAction (N.getWith opts url)++-- | Request a new access token from Azure using the specified client+-- id and client secret+getAccessToken :: ByteString -> ByteString -> ExceptT BingError IO BingContext+getAccessToken clientId clientSecret = do+  req <- post tokenAuthPage  [+    "client_id" N.:= clientId,+    "client_secret" N.:= clientSecret,+    scopeArg,+    grantType+    ]+  r <- N.asJSON req+  let t = r ^. N.responseBody+  t' <- liftIO $ getCurrentTime+  return $ BCTX{+    accessToken = t,+    inception = t',+    clientId = clientId,+    clientSecret = clientSecret+    }++-- | Check if the access token of the running BingAction is still+-- valid. If the token has expired, renews the token automatically+checkToken :: BingContext -> ExceptT BingError IO BingContext+checkToken ctx@BCTX{..} = do+  t <- liftIO $ getCurrentTime+  if diffSeconds t inception > expires accessToken - 100 then do+    BCTX{accessToken = tk} <- getAccessToken clientId clientSecret+    t' <- liftIO $ getCurrentTime+    return $ ctx{accessToken = tk, inception = t'}+  else+    return $ ctx++withContext = BM++-- | Action that translates text inside a BingMonad context.+translateM :: Text -> BingLanguage -> BingLanguage -> BingMonad Text+translateM text from to = do+  let opts = N.defaults & N.param "from" .~ [toSym from :: Text]+             & N.param "to" .~ [toSym to]+             & N.param "contentType" .~ ["text/plain"]+             & N.param "category" .~ ["general"]+             & N.param "text" .~ [text]+  res <- getWithAuth opts translateUrl+  let trans = parseXML $ (TE.decodeUtf8 $ BLC.toStrict $ res ^. N.responseBody)+  case find (\n -> case n of+                Elem e -> "string" == (qName $ elName e)+                _ -> False) trans of+    Just (Elem e) -> return $ T.pack $ strContent e+    _ -> BM $ \_ -> throwE $ BingError $ pack $ show res++-- | Helper function that evaluates a BingMonad action. It simply+-- requests and access token and uses the token for evaluation.+evalBing :: ClientId -> ClientSecret -> BingMonad a -> IO (Either BingError a)+evalBing clientId clientSecret action = runExceptT $ do+  t <- getAccessToken clientId clientSecret+  runBing action t++-- | Toplevel wrapper that translates a text. It is only recommended if translation+-- is invoked less often than every 10 minutes since it always+-- requests a new access token.  For better performance use+-- translateM, runBing and getAccessToken+translate :: ClientId -> ClientSecret -> Text -> BingLanguage -> BingLanguage -> IO (Either BingError Text)+translate cid cs text from to = evalBing cid cs (translateM text from to)