reddit.hs

{-# LANGUAGE TemplateHaskell, OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}

import Network.URI (URI, parseURI)
import Network.HTTP
import Control.Applicative
import Data.Aeson
import qualified Data.ByteString.Lazy as BL
import Data.Maybe (fromJust)

redditURL = fromJust . parseURI $ "http://www.reddit.com/by_id/t3_1c578w.json"

getJSON :: URI -> IO BL.ByteString
getJSON url = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody

data Votes = Votes
  { ups   :: Int
  , downs :: Int
  , likes :: Maybe Bool
  } deriving Show

instance FromJSON Votes where
  parseJSON (Object o) = Votes <$> o .: "ups"
                               <*> o .: "downs"
                               <*> o .:? "likes"
data Link = Link 
  { link_votes :: Votes
  } deriving Show

instance FromJSON Link where
  parseJSON v@(Object _) = do
    vote <- parseJSON v
    -- parseJSON again for each of your types:
    -- cinfo <- parseJSON o
    -- ...
    return $ Link vote

{-
Since the data for each Link starts deep in the json 
at {"data":{"children":[{"data": <here>}]}} we use this 
function to unwrap things first. It requires enabling
a few extensions to be able to write a FromJSON instance for
[Link], but this way other FromJSON instances like Votes 
can just act on the nested object without having to unwrap again.
-}
instance FromJSON [Link] where
  parseJSON (Object o) = do
    children <- o .: "data" >>= (.: "children")
    datas <- mapM (.: "data") children
    mapM parseJSON datas

main = do
  bs <- getJSON redditURL
  case decode bs of
    Nothing    -> return ()
    Just links -> print $ map link_votes links