accentuateus (empty) → 0.9
raw patch · 5 files changed
+227/−0 lines, 5 filesdep +HTTPdep +basedep +jsonsetup-changed
Dependencies added: HTTP, base, json, network
Files
- LICENSE +30/−0
- README.mkd +28/−0
- Setup.hs +3/−0
- Text/AccentuateUs.hs +148/−0
- accentuateus.cabal +18/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Spearhead Development, L.L.C.++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 Spearhead Development, L.L.C. 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.
+ README.mkd view
@@ -0,0 +1,28 @@+Copyright (c) 2011 [Spearhead Development, L.L.C.](http://spearheaddev.com/).++Released under the BSD3 License. Please see the included `LICENSE` file.++Introduction+============+This project was created by [Spearhead Development](http://spearheaddev.com/) to+implement the [Accentuate.us](http://accentuate.us/) API.++Calls+=====++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).
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ Text/AccentuateUs.hs view
@@ -0,0 +1,148 @@+module Text.AccentuateUs+ ( AUSResponse(..)+ , LangsStatus(..)+ , langs+ , accentuate+ , feedback+ ) where++import Control.Monad (liftM)+import Data.Maybe (fromJust)+import Network.HTTP (Header(Header), HeaderName(..), Request(Request)+ , RequestMethod(POST), getResponseBody, simpleHTTP)+import Network.URI (URI(URI), URIAuth(URIAuth))+import Text.JSON (JSON(..), decode, encode, JSValue(..), resultToEither,+ toJSObject, valFromObj)++type Lang = String+type Locale = String++-- | Get langs and their localized names+langs :: Maybe Locale -> Int -> IO (Either String AUSResponse)+langs l v = liftM eitherDecode $+ post [PCall "langs", PLocale (mbLocale l), PVersion v]++-- | For a given language, and optionally a locale, accentuates text+accentuate :: Lang -> Maybe Locale -> String -> IO (Either String AUSResponse)+accentuate la lo t = liftM eitherDecode $+ post [PCall "lift", PLang la, PLocale (mbLocale lo), PText t]++-- | Submits corrected text as feedback to Accentuate.us+feedback :: Lang -> Maybe Locale -> String -> IO (Either String AUSResponse)+feedback la lo t = liftM eitherDecode $+ post [PCall "feedback", PLang la, PLocale (mbLocale lo), PText t]++-- | Encapsulates various properties of an Accentuate.us API call+data Param+ = PCall String+ | PCode Integer+ | PText String+ | PLang Lang+ | PLocale Locale+ | PVersion Int+ deriving (Show)++-- | Represents responses for the three Accentuate.us calls+data AUSResponse+ = Langs { status :: LangsStatus+ , version :: Int+ , languages :: [(String, Lang)] -- ^ [(ISO-639, Localized Language)]+ }+ | Lift { text :: String }+ | Feedback+ deriving Show++-- | Represents languages response status+data LangsStatus = OutOfDate -- ^ Given version number < server's+ | UpToDate -- ^ Given version number == server's+ | OverDate -- ^ Given version number > server's+ deriving (Show, Eq)++instance JSON AUSResponse where+ readJSON (JSObject rsp) = do+ call <- valFromObj "call" rsp+ code <- valFromObj "code" rsp+ case call of+ "charlifter.langs" -> let code' = mbCodeToStatus code in do+ vers <- valFromObj "version" rsp+ pairs <- pairs' code'+ return Langs { status = code'+ , version = read vers+ , languages = pairs+ }+ where pairs' UpToDate = return []+ pairs' _ = liftM (map splitPair . lines) txt+ txt = valFromObj "text" rsp+ "charlifter.lift" ->+ case code::Int of+ 200 -> liftM Lift (valFromObj "text" rsp)+ 400 -> fail'+ _ -> fail "Unknown Accentuate.us response code."+ "charlifter.feedback" ->+ case code::Int of+ 100 -> return Feedback+ 400 -> fail'+ _ -> fail "Unknown Accentuate.us response code."+ _ -> fail "Unknown Accentuate.us call."+ where fail' = (valFromObj "text" rsp) >>= \e -> fail e+ mbCodeToStatus = fromJust . codeToStatus+ readJSON _ = undefined+ showJSON = undefined++-- | Converts integer response code into data type LangsStatus+codeToStatus :: Int -> Maybe LangsStatus+codeToStatus c = case c of+ 100 -> Just OutOfDate+ 200 -> Just UpToDate+ 400 -> Just OverDate+ _ -> 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)++-- | Sends response to server+post :: [Param] -> IO String+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 = maybe "" id $ "lang" `lookup` ps++-- | Map parameters to call-appropriate tuples+toQuery :: [Param] -> [(String, String)]+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)++-- | Produces locale from Maybe+mbLocale :: Maybe Locale -> Locale+mbLocale (Just l) = l+mbLocale Nothing = ""++-- | Common response parsing+eitherDecode :: (JSON a) => String -> Either String a+eitherDecode = resultToEither . decode++-- | 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++-- | 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
+ accentuateus.cabal view
@@ -0,0 +1,18 @@+Name: accentuateus+Version: 0.9+Description: A Haskell implementation of the Accentuate.us API.+Synopsis: A Haskell implementation of the Accentuate.us API.+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+Extra-source-files: README.mkd+Cabal-version: >=1.2++Library+ Exposed-modules: Text.AccentuateUs+ ghc-options: -Wall+ Build-depends: base >= 3 && < 5, HTTP, json, network