accentuateus 0.9.1 → 0.9.2
raw patch · 4 files changed
+138/−82 lines, 4 filesdep +bytestringdep +textdep ~HTTPdep ~jsondep ~networkbuild-type:Custom
Dependencies added: bytestring, text
Dependency ranges changed: HTTP, json, network
Files
- LICENSE +1/−1
- README.mkd +3/−16
- accentuateus.cabal +18/−5
- src/Text/AccentuateUs.hs +116/−60
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2011, Spearhead Development, L.L.C.+Copyright (c) 2011, Spearhead Development, L.L.C. All rights reserved.
README.mkd view
@@ -18,19 +18,6 @@ Usage ===== -There are three primary calls to access Accentuate.us:--* `langs (Maybe Locale) (Version)`-- `langs (Just "en") 9`--* `accentuate (Language) (Maybe Locale) (Text)`-- `accentuate "ga" Nothing "al chead"`--* `feedback (Language) (Maybe Locale) (*Corrected* Text)`-- `feedback "ht" (Just "en") "lè la wè"`--The locales are included to provide localized error messages (or, in the case-of `langs`, localized language names).+See Haddock documentation (available on+[Hackage](http://hackage.haskell.org/package/accentuateus)) for usage+instructions.
accentuateus.cabal view
@@ -1,17 +1,25 @@ Name: accentuateus-Version: 0.9.1+Version: 0.9.2 Homepage: http://accentuate.us/-Description: A Haskell implementation of the Accentuate.us API. Synopsis: A Haskell implementation of the Accentuate.us API.+Description: Accentuate.us (<http://accentuate.us/>) is a free+ and open-source web service that makes computer+ input really easy for over 115 languages. Using+ statistics, it will automatically add diacritics+ (\"special characters\") to otherwise plain text.+ In support of being an open web service, an API is+ provided and documented at+ <http://accentuate.us/api>, which is implemented+ by this package. License: BSD3 License-file: LICENSE Author: Spearhead Development, L.L.C. Maintainer: Michael Schade <michael@spearheaddev.com> Copyright: (c) 2011 Spearhead Development, L.L.C. Category: Web-Build-type: Simple+Build-type: Custom Extra-source-files: README.mkd-Cabal-version: >=1.6+Cabal-version: >= 1.6 source-repository head type: git@@ -20,5 +28,10 @@ Library Exposed-modules: Text.AccentuateUs ghc-options: -Wall -fwarn-tabs- Build-depends: base >= 3 && < 5, HTTP, json, network Hs-Source-Dirs: src+ Build-depends: base >= 3 && < 5+ , bytestring == 0.9.1.*+ , HTTP == 4000.1.*+ , json == 0.4.*+ , network == 2.3.*+ , text == 0.11.*
src/Text/AccentuateUs.hs view
@@ -1,5 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+ module Text.AccentuateUs- ( Lang+ ( -- $doc+ Lang , Locale , AUSResponse(..) , LangsStatus(..)@@ -8,56 +11,89 @@ , feedback ) where -import Control.Monad (liftM)-import Data.Maybe (fromMaybe)-import Network.HTTP (Header(Header), HeaderName(..), Request(Request)- , RequestMethod(POST), getResponseBody, simpleHTTP, catchIO)-import Network.URI (URI(URI), URIAuth(URIAuth))-import Text.JSON (JSON(..), decode, encode, JSValue(..), resultToEither,- toJSObject, valFromObj)+import Control.Monad ( liftM )+import Data.Maybe ( fromMaybe )+import Data.Text.Encoding ( decodeUtf8, encodeUtf8 )+import Text.JSON ( JSON(..), JSValue(..), Result(Ok, Error), decode+ , encode, toJSObject, valFromObj+ )+import Network.HTTP ( Header(Header), HeaderName(..), Request(Request)+ , RequestMethod(POST), getResponseBody, simpleHTTP+ , catchIO+ )+import Network.URI ( URI(URI), URIAuth(URIAuth) )+import qualified Data.ByteString.Char8 as C8+import qualified Data.Text as T -type Lang = String-type Locale = String+type Lang = C8.ByteString -- ^ An ISO-639 code.+type Locale = C8.ByteString -- ^ An ISO-639 code. --- | Get langs and their localized names-langs :: Maybe Locale -> Int -> IO (Either String AUSResponse)+-- | Get langs and their localized names. E.g.,+--+-- > getEnglishName langs = fromMaybe "Not Found" $ "en" `lookup` langs+-- >+-- > TIO.putStrLn =<< liftM (either decodeUtf8 (getEnglishName . languages))+-- > (langs (Just "ga") 0)+--+-- The above example will get the localized name for English (ISO-639: en) for+-- localized into Irish (ISO-639: ga).+langs :: Maybe Locale -> Int -> IO (Either C8.ByteString AUSResponse) langs l v = catchIO (liftM eitherDecode call) (\_ -> err) where- call = post [PCall "langs", PLocale (fromMaybe "" l), PVersion v]- err = return . Left $ "Network error. Unale to retrieve languages."+ call = post [PCall "langs", PLocale (mbString l), PVersion v]+ err = return . Left $ "Network error. Unable to retrieve languages." --- | For a given language, and optionally a locale, accentuates text-accentuate :: Lang -> Maybe Locale -> String -> IO (Either String AUSResponse)+-- | For a given language, and optionally a locale, accentuates text. This+-- function is that which does the heavy lifting, restoring diacritics+-- (special characters) to otherwise plain text. E.g.,+--+-- > TIO.putStrLn =<< liftM (either decodeUtf8 text)+-- > (accentuate "vie" (Just "en") "My tu bo ke hoach la chan ten lua")+--+-- The above example accentuates the input text ("My tu...") in Vietnamese+-- with an English localization of error responses.+accentuate :: Lang -> Maybe Locale -> T.Text+ -> IO (Either C8.ByteString AUSResponse) accentuate la lo t = catchIO (liftM eitherDecode call) (\_ -> err) where- call = post [PCall "lift", PLang la, PLocale (mbLocale lo), PText t]- err = return . Left $ "Network error. Unable to accentuate text for"- ++ " language " ++ la+ call = post [PCall "lift", PLang la, PLocale (mbString lo), PText t]+ err = return . Left $ C8.append+ "Network error. Unable to accentuate text for language " la --- | Submits corrected text as feedback to Accentuate.us-feedback :: Lang -> Maybe Locale -> String -> IO (Either String AUSResponse)+-- | Submits corrected text as feedback to Accentuate.us. It is helpful for all+-- users if developers make good use of this function as it helps improve the+-- Accentuate.us language models by retraining them.+--+-- > feedback "ht" (Just "en")+-- > "Bon, la fè sa apre demen pito, lè la wè mwen andèy."+--+-- This example submits the *correct* input text (all diacritics in their+-- proper places) to the Accentuate.us servers to be queued for language model+-- retraining.+feedback :: Lang -> Maybe Locale -> T.Text+ -> IO (Either C8.ByteString AUSResponse) feedback la lo t = catchIO (liftM eitherDecode call) (\_ -> err) where- call = post [PCall "feedback", PLang la, PLocale (mbLocale lo), PText t]+ call = post [PCall "feedback", PLang la, PLocale (mbString lo), PText t] err = return . Left $ "Network error. Unable to submit feedback." -- | Encapsulates various properties of an Accentuate.us API call data Param- = PCall String- | PCode Integer- | PText String- | PLang Lang- | PLocale Locale- | PVersion Int+ = PCall C8.ByteString+ | PCode Integer+ | PText T.Text+ | PLang Lang+ | PLocale Locale+ | PVersion Int deriving (Show) --- | Represents responses for the three Accentuate.us calls+-- | Represents responses for the three Accentuate.us calls. data AUSResponse = Langs { status :: LangsStatus , version :: Int- , languages :: [(String, Lang)] -- ^ [(ISO-639, Localized Language)]+ , languages :: [(Lang, T.Text)] -- ^ [(ISO-639, Localized Language)] }- | Lift { text :: String }+ | Lift { text :: T.Text } | Feedback deriving Show @@ -81,11 +117,11 @@ , languages = pairs } where pairs' UpToDate = return []- pairs' _ = liftM (map splitPair . lines) txt+ pairs' _ = liftM (map splitPair . C8.lines) txt txt = valFromObj "text" rsp "charlifter.lift" -> case code::Int of- 200 -> liftM Lift (valFromObj "text" rsp)+ 200 -> liftM (Lift . decodeUtf8) (valFromObj "text" rsp) 400 -> fail' _ -> failCode "charlifter.feedback" ->@@ -110,50 +146,70 @@ _ -> Nothing -- | Splits a string pair (separated by :) into a tuple, removing separator-splitPair :: String -> (String, String)-splitPair s = removeSep $ break (== ':') s- where removeSep (a,b) = (a, tail b)+splitPair :: C8.ByteString -> (C8.ByteString, T.Text)+splitPair s = removeSep $ C8.break (== ':') s+ where removeSep (a, b) = (a, decodeUtf8 . C8.tail $ b) -- | Sends response to server-post :: [Param] -> IO String+post :: [Param] -> IO C8.ByteString post ps = (simpleHTTP . prepRequest $ ps) >>= \r -> getResponseBody r -- | Create request-prepRequest :: [Param] -> Request String-prepRequest params = Request (url lang) POST (headers body) body- where ps = toQuery params- body = encode . toJSObject $ ps- lang = fromMaybe "" ("lang" `lookup` ps)+prepRequest :: [Param] -> Request C8.ByteString+prepRequest params = Request (url lang) POST (headers body) body+ where ps = toQuery params+ body = C8.pack . encode . toJSObject $ ps+ lang = mbString ("lang" `lookup` ps) -- | Map parameters to call-appropriate tuples-toQuery :: [Param] -> [(String, String)]+toQuery :: [Param] -> [(String, C8.ByteString)] toQuery = map toQuery' where toQuery' p = case p of- PCall c -> ("call", "charlifter." ++ c)- PCode c -> ("code", show c)- PText t -> ("text", t)- PLang l -> ("lang", l)- PLocale l -> ("locale", l)- PVersion v -> ("version", show v)+ PCall c -> ("call", "charlifter." `C8.append` c)+ PCode c -> ("code", C8.pack . show $ c)+ PText t -> ("text", encodeUtf8 t)+ PLang l -> ("lang", l)+ PLocale l -> ("locale", l)+ PVersion v -> ("version", C8.pack . show $ v) -- | Common response parsing-eitherDecode :: (JSON a) => String -> Either String a-eitherDecode = resultToEither . decode+eitherDecode :: (JSON a) => C8.ByteString -> Either C8.ByteString a+eitherDecode = resultToEither' . decode . C8.unpack+ where resultToEither' (Ok a) = Right a+ resultToEither' (Error s) = Left . C8.pack $ s --- | Conversion from optional locale parameter to (empty) string.-mbLocale :: Maybe String -> String-mbLocale = fromMaybe ""+-- | Conversion from optional parameter to (empty) string.+mbString :: Maybe C8.ByteString -> C8.ByteString+mbString = fromMaybe "" -- | Generate appropriate headers-headers :: String -> [Header]-headers s = [Header HdrContentType "application/json; charset=utf-8"- , Header HdrUserAgent "Accentuate.us/0.9 haskell"- , Header HdrContentLength cl- ] where cl = show . length $ s+headers :: C8.ByteString -> [Header]+headers s =+ [ Header HdrContentType "application/json; charset=utf-8"+ , Header HdrUserAgent "Accentuate.us/0.9 haskell"+ , Header HdrContentLength (show . length . C8.unpack $ s)+ ] -- | Generate language-specific URL url :: Lang -> URI url lang = URI "http:" uriAuth "/" "" "" where uriAuth = Just (URIAuth "" host ":8080") base = "api.accentuate.us"- host = (if lang /= "" then lang ++ "." else lang) ++ base+ host = (if lang' /= "" then lang' ++ "." else lang') ++ base+ lang' = C8.unpack lang++-- $doc+--+-- This package implements the Accentuate.us (<http://accentuate.us/>) API as it+-- is described at <http://accentuate.us/api>.+--+-- The documentation's examples assume the following conditions:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Text.AccentuateUs+-- > import Control.Monad (liftM)+-- > import Data.Either (either)+-- > import Data.Maybe (fromMaybe)+-- > import Data.Text.Encoding (decodeUtf8)+-- > import qualified Data.Text.IO as TIO