jonathanscard (empty) → 0.1

raw patch · 5 files changed

+181/−0 lines, 5 filesdep +HTTPdep +basedep +bytestringsetup-changed

Dependencies added: HTTP, base, bytestring, containers, json, mtl, network

Files

• LICENSE +30/−0
• README.mkd +17/−0
• Setup.hs +2/−0
• jonathanscard.cabal +31/−0
• src/Web/JonathansCard.hs +101/−0

@@ -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.

@@ -0,0 +1,17 @@+# Overview++This is an implementation of the [Jonathan's Card API](http://jonathanstark.com/card/#api).+The API is created by [Jonathan Stark](http://jonathanstark.com/),+while this implementation is created by [Michael Schade](http://mschade.me/)+([@michaelschade](https://twitter.com/intent/user?screen_name=michaelschade))++# Usage++Usage is fairly self-explanatory. Simply make a call to:++* `balances`+* `changes`+* `latest`++and then unwrap it from the IO and Either monads to play with `Balance`+or `Change`.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,31 @@+Name:                jonathanscard+Version:             0.1+Synopsis:            An implementation of the Jonathan's Card API.+Description:         This implements the Jonathan's Card API, as detailed at+                     <http://jonathanstark.com/card/#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.6++source-repository head+    type:       git+    location:   git://github.com/michaelschade/hs-jonathanscard.git++Library+  -- Modules exported by the library.+    ghc-options:        -Wall -fwarn-tabs+    Hs-Source-Dirs:     src+    Exposed-modules:      Web.JonathansCard+    Build-depends:        base          >= 3 && < 5+                        , bytestring    >= 0.9+                        , containers    == 0.4.*+                        , HTTP          == 4000.1.*+                        , json          == 0.4.4+                        , mtl           == 2.0.1.*+                        , network       == 2.3.*

@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}++module Web.JonathansCard+    (+      Balance(..)+    , Change(..)+    , balances+    , latest+    , changes+    ) where++import Control.Monad        ( ap, liftM )+import Text.JSON            ( JSON(..), JSObject(..), JSValue(..), Result+                            , decode, resultToEither, valFromObj+                            )+import Network.HTTP         ( Header(Header), HeaderName(..), Request(Request)+                            , RequestMethod(GET), getResponseBody, simpleHTTP+                            , catchIO+                            )+import Network.URI          ( URI(URI), URIAuth(URIAuth) )+import Data.ByteString.Char8 ( ByteString, unpack )++-- | Represents a Balance on Jonathan's Card+data Balance = Balance+    { balAmount     :: Double+    , balBalanceId  :: Int+    , balCreated    :: String+    , balMessage    :: String+    } deriving Show++-- | Represents the changes over time on Jonathan's Card+data Change = Change+    { chgBalance    :: Double+    , chgCreated    :: String+    , chgDelta      :: Double+    } deriving Show++-- | Retrieve a list of balances on Jonathan's Card+balances :: IO (Either String [Balance])+balances  = apiCall "balances" "balances" "balances"++-- | Retrieve the latest balance on Jonathan's Card+latest :: IO (Either String Balance)+latest  = apiCall "latest" "balance" "latest balance"++-- | Retrieve the changes in amounts on Jonathan's Card+changes :: IO (Either String [Change])+changes  = apiCall "changes" "changes" "changes"++-- | Abstracts the details of the API call and body parsing.+apiCall :: JSON a => String -> String -> String -> IO (Either String a)+apiCall endpoint parent errObject = flip catchIO (\_ -> err) $ do+    rsp <- (decode . unpack) `liftM` request endpoint+    return . resultToEither $ valFromObj parent =<< rsp+    where err = return . Left $ "Unable to retrieve " ++ errObject ++ "."++-----------------------+-- Request Utilities --+-----------------------++-- | Sends response to server+request  :: String -> IO ByteString+request p = (simpleHTTP $ prepRq p) >>= getResponseBody++-- | Prepare request to API+prepRq  :: String -> Request ByteString+prepRq p = Request (url p) GET headers ""+    where+        headers = [ Header HdrAccept    "application/json"+                  , Header HdrUserAgent "JonathansCard/0.1 haskell"+                  ]++-- | Define request URL based on endpoint+url  :: String -> URI+url p = URI "http:" uriAuth ("/card/api/" ++ p) "" ""+    where uriAuth = Just $ URIAuth "" "jonathanstark.com" ":80"++----------------------------+-- JSON Parsing Utilities --+----------------------------++-- | Convenient name to get a field from a given 'JSON' object.+get :: JSON a => JSObject JSValue -> String -> Result a+get  = flip valFromObj++instance JSON Balance where+    readJSON (JSObject rsp) = do+        Balance  `liftM` (read `liftM` get rsp "amount")+                    `ap` (read `liftM` get rsp "balance_id")+                    `ap` get rsp "created_at"+                    `ap` get rsp "message"+    readJSON _ = undefined+    showJSON   = undefined++instance JSON Change where+    readJSON (JSObject rsp) = do+        Change   `liftM` (read `liftM` get rsp "balance")+                    `ap` get rsp "created_at"+                    `ap` (read `liftM` get rsp "delta")+    readJSON _ = undefined+    showJSON   = undefined