github.hs

import Network.HTTP (getResponseBody, simpleHTTP, getRequest)
import qualified Text.JSON as JSON


data GithubUser = GithubUser {
        name     :: String,
        location :: String
    } deriving (Eq, Show)


instance JSON.JSON GithubUser where
    readJSON (JSON.JSObject object) =
        let (Just a)          = lookupM "user" $ JSON.fromJSObject object
            (JSON.JSObject b) = a
            user              = JSON.fromJSObject b
        in do name     <- lookupM "name"     user >>= JSON.readJSON
              location <- lookupM "location" user >>= JSON.readJSON
              return $ GithubUser {
                  name     = name,
                  location = location
              }

    showJSON user = JSON.makeObj [
                        ("name",     JSON.showJSON $ name user),
                        ("location", JSON.showJSON $ location user)
                    ]


lookupM :: (Monad m) => String -> [(String, a)] -> m a
lookupM x xs = maybe (fail $ "No such element: " ++ x) return (lookup x xs)


request :: String -> IO String
request url = simpleHTTP (getRequest url) >>= getResponseBody


main = do jsonText <- request "http://github.com/api/v2/json/user/show/igstan"
          let result = JSON.decode jsonText :: JSON.Result GithubUser
          showResult result
       where showResult (JSON.Ok json) = putStrLn $ name json
             showResult (JSON.Error e) = putStrLn e