diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -8,20 +8,23 @@ High-level, up-to-date bindings to the Google Translate API. ```haskell +{-# LANGUAGE OverloadedStrings #-} import Control.Monad import qualified Data.Text.IO as T -import Data.Maybe -import Web.Google.Translate - +import Network.HTTP.Client +import Network.HTTP.Client.TLS +import Web.Google.Translate + main :: IO () main = do Right TranslationResponse { translations = xs } <- - translate (Key "") (Just srcLang) trgLang (Body "Hello") + newManager tlsManagerSettings >>= \mgr -> + translate mgr (Key "") (Just srcLang) trgLang (Body "Hello") forM_ xs $ \Translation { translatedText = TranslatedText txt } -> T.putStrLn txt where srcLang = Source English trgLang = Target Russian - --- >>> Здравствуйте -``` + +-- >>> Здравствуйте +``` diff --git a/google-translate.cabal b/google-translate.cabal --- a/google-translate.cabal +++ b/google-translate.cabal @@ -1,9 +1,9 @@ name: google-translate -version: 0.1.1.2 +version: 0.2 synopsis: Google Translate API bindings license: BSD3 license-file: LICENSE -author: David Johnson +author: David Johnson, Dmitry Dzhus maintainer: djohnson.m@gmail.com copyright: David Johnson (c) 2016 category: Web @@ -20,9 +20,11 @@ build-depends: aeson , base >= 4.7 && < 5 , bytestring == 0.10.* - , either == 4.4.* - , servant == 0.4.* - , servant-client == 0.4.* + , transformers >= 0.4 && < 0.6 + , http-api-data == 0.2.* + , http-client == 0.4.* + , servant == 0.7.* + , servant-client == 0.7.* , text == 1.2.* default-language: Haskell2010 diff --git a/src/Web/Google/Translate.hs b/src/Web/Google/Translate.hs --- a/src/Web/Google/Translate.hs +++ b/src/Web/Google/Translate.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -10,7 +8,7 @@ ------------------------------------------------------------------------------ -- | -- Module : Web.Google.Translate --- Copyright : (c) David Johnson 2015 +-- Copyright : (c) David Johnson 2016 -- Maintainer : djohnson.m@gmail.com -- Stability : experimental -- Portability : POSIX @@ -42,38 +40,35 @@ , Language (..) ) where ------------------------------------------------------------------------------ -import Control.Applicative -import Control.Monad.Trans.Either +import Control.Monad.Trans.Except import Data.Aeson -import Data.Aeson.Types -import Data.Maybe import Data.Proxy import Data.Text (Text) import qualified Data.Text as T import GHC.Generics -import GHC.TypeLits +import Network.HTTP.Client (Manager) import Servant.API import Servant.Client ------------------------------------------------------------------------------ -- | API Key newtype Key = Key Text - deriving (ToText, FromText, Show, Eq, Ord) + deriving (ToHttpApiData, FromHttpApiData, Show, Eq, Ord) ------------------------------------------------------------------------------ -- | Source Language newtype Source = Source Lang - deriving (ToText, FromText, Show, Eq, Ord) + deriving (ToHttpApiData, Show, Eq, Ord) ------------------------------------------------------------------------------ -- | Target Language newtype Target = Target Lang - deriving (ToText, FromText, Show, Eq, Ord) + deriving (ToHttpApiData, Show, Eq, Ord) ------------------------------------------------------------------------------ -- | Text for translation newtype Body = Body Text - deriving (ToText, FromText, Show, Eq, Ord) + deriving (ToHttpApiData, FromHttpApiData, Show, Eq, Ord) ------------------------------------------------------------------------------ -- | Translated Text newtype TranslatedText = TranslatedText Text - deriving (ToText, FromText, Show, Eq, Ord, FromJSON) + deriving (ToHttpApiData, FromHttpApiData, Show, Eq, Ord, FromJSON) ------------------------------------------------------------------------------ -- | Translation Reponse data TranslationResponse = TranslationResponse { @@ -81,11 +76,11 @@ } deriving (Show, Eq, Ord, Generic) ------------------------------------------------------------------------------ instance FromJSON TranslationResponse where - parseJSON (Object o) = do + parseJSON = withObject "translations" $ \o -> do d <- o .: "data" TranslationResponse <$> d .: "translations" ------------------------------------------------------------------------------ --- | Translation +-- | Translation data Translation = Translation { translatedText :: TranslatedText , detectedSourceLanguage :: Maybe Lang @@ -99,7 +94,7 @@ } deriving (Show, Eq, Ord, Generic) ------------------------------------------------------------------------------ instance FromJSON DetectionResponse where - parseJSON (Object o) = do + parseJSON = withObject "detetctions" $ \o -> do d <- o .: "data" DetectionResponse <$> d .: "detections" ------------------------------------------------------------------------------ @@ -124,18 +119,19 @@ } deriving (Show, Eq, Ord, Generic) ------------------------------------------------------------------------------ instance FromJSON LanguageResponse where - parseJSON (Object o) = do + parseJSON = withObject "languages" $ \o -> do d <- o .: "data" LanguageResponse <$> d .: "languages" ------------------------------------------------------------------------------ --- | Language +-- | Language data Language = Language { lang :: Lang , name :: Maybe LanguageName } deriving (Show, Eq, Generic, Ord) ------------------------------------------------------------------------------ instance FromJSON Language where - parseJSON (Object o) = Language <$> o .: "language" <*> o .:? "name" + parseJSON = withObject "language" $ \o -> + Language <$> o .: "language" <*> o .:? "name" ------------------------------------------------------------------------------ -- | Language Name newtype LanguageName = LanguageName Text deriving (Show, Eq, Ord, FromJSON) @@ -172,41 +168,55 @@ -> Maybe Source -> Maybe Target -> Maybe Body - -> EitherT ServantError IO TranslationResponse + -> Manager + -> BaseUrl + -> ExceptT ServantError IO TranslationResponse detect' :: Maybe Key -> Maybe Body - -> EitherT ServantError IO DetectionResponse -translate' :<|> detect' :<|> getLanguages' = client api (BaseUrl Https "www.googleapis.com" 443) + -> Manager + -> BaseUrl + -> ExceptT ServantError IO DetectionResponse +getLanguages' + :: Maybe Key + -> Maybe Target + -> Manager + -> BaseUrl + -> ExceptT ServantError IO LanguageResponse +translate' :<|> detect' :<|> getLanguages' = client api ------------------------------------------------------------------------------ +googleApis :: BaseUrl +googleApis = BaseUrl Https "www.googleapis.com" 443 "/" +------------------------------------------------------------------------------ -- | Detect target language detect - :: Key + :: Manager + -> Key -> Body -> IO (Either ServantError DetectionResponse) -detect key body = runEitherT $ detect' (Just key) (Just body) +detect mgr key body = runExceptT $ detect' (Just key) (Just body) mgr googleApis ------------------------------------------------------------------------------ -- | Perform translation from `Source` language to `Target` langauge. -- If `Source` not specified, attempt detection of `Lang` translate - :: Key + :: Manager + -> Key -> Maybe Source -> Target -> Body -> IO (Either ServantError TranslationResponse) -translate key src trgt body = - runEitherT $ translate' (Just key) src (Just trgt) (Just body) +translate mgr key src trgt body = + runExceptT $ translate' (Just key) src (Just trgt) (Just body) mgr googleApis ------------------------------------------------------------------------------ -- | Retrieve all languages -- If `Target` specified, return langauge name in `Target` langauge. -getLanguages - :: Key +getLanguages + :: Manager + -> Key -> Maybe Target -> IO (Either ServantError LanguageResponse) -getLanguages key trgt = runEitherT $ getLanguages' (Just key) trgt ------------------------------------------------------------------------------- -toTxt :: Show a => a -> Text -toTxt = T.pack . show +getLanguages mgr key trgt = + runExceptT $ getLanguages' (Just key) trgt mgr googleApis ------------------------------------------------------------------------------ instance Show Lang where show Afrikaans = "af" @@ -396,13 +406,8 @@ | Zulu deriving (Eq, Ord) ------------------------------------------------------------------------------ -instance ToText Lang where toText = toTxt ------------------------------------------------------------------------------- -instance FromText Lang where - fromText txt = - case fromJSON (String txt) of - Success x -> Just x - _ -> Nothing +instance ToHttpApiData Lang where + toUrlPiece = T.pack . show ------------------------------------------------------------------------------ instance FromJSON Lang where parseJSON (String "af") = pure Afrikaans @@ -496,8 +501,8 @@ parseJSON (String "yi") = pure Yiddish parseJSON (String "yo") = pure Yoruba parseJSON (String "zu") = pure Zulu + parseJSON (String _) = fail "Unknown language code" + parseJSON _ = fail "Expecting language code as a JSON string" ------------------------------------------------------------------------------ instance ToJSON Lang where - toJSON = String . toTxt - - + toJSON = String . toUrlPiece