Gists for a blog post about Haskell, http-streams and Aeson: http://joshrotenberg.com/haskell/2013/05/28/http-streams-and-aeson/

.gitignore

.hsenv/
hsenv.log
*.hi
*.o

AesonSimple.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Aeson (FromJSON, ToJSON, decode, encode)
import Data.ByteString.Lazy.Char8 
import GHC.Generics (Generic)

-- feed metadata
data MetaData = MetaData {
      url :: String,
      title :: String
} deriving (Show, Generic)

instance FromJSON MetaData

-- feature properties
data Properties = Properties {
      detail :: String,
      mag :: Double
} deriving (Show, Generic)

instance FromJSON Properties

-- the feature itself
data Feature = Feature {
      id :: String,
      properties :: Properties
} deriving (Show, Generic)

instance FromJSON Feature

-- and our top level feed container type
data Feed = Feed {
      metadata :: MetaData,
      features :: [Feature]
} deriving (Show, Generic)

instance FromJSON Feed

main :: IO ()
main = do
  let req = decode "{\"metadata\":{\"url\":\"FeatureCollection\",\"title\":\"USGS All Earthquakes, Past Hour\"},\"features\":[{\"id\":\"ci15351137\", \"properties\":{\"detail\":\"http://earthquake.usgs.gov/earthquakes/feed/v1.0/detail/ci15351137.geojson\", \"mag\":1.1}}]}" :: Maybe Feed
  case req of
    Nothing -> print "parse failed"
    Just f -> print f

HTTPStreams.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified Data.ByteString as S
import Network.Http.Client

main :: IO ()
main = do
  c <- openConnection "earthquake.usgs.gov" 80

  q <- buildRequest $ do
         http GET "/earthquakes/feed/v1.0/summary/all_day.geojson"
         setAccept "application/json"

  sendRequest c q emptyBody

  x <- receiveResponse c concatHandler -- debugHandler

  S.putStr x

  closeConnection c

HTTPStreamsAeson.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}

module Main where

import Data.Aeson (FromJSON, ToJSON, decode)
import Data.ByteString.Lazy.Char8
import GHC.Generics (Generic)
import System.IO.Streams (InputStream)
import qualified System.IO.Streams as Streams
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy.Char8 as BL
import Network.Http.Client

-- feed metadata
data MetaData = MetaData {
      url :: String,
      title :: String
} deriving (Show, Generic)

instance FromJSON MetaData

-- feature properties
data Properties = Properties {
      detail :: String,
      mag :: Double
} deriving (Show, Generic)

instance FromJSON Properties

-- the feature itself
data Feature = Feature {
      id :: String,
      properties :: Properties
} deriving (Show, Generic)

instance FromJSON Feature

-- and our top level feed container type
data Feed = Feed {
      metadata :: MetaData,
      features :: [Feature]
} deriving (Show, Generic)

instance FromJSON Feed

main :: IO ()
main = do
  c <- openConnection "earthquake.usgs.gov" 80

  q <- buildRequest $ do
         http GET "/earthquakes/feed/v1.0/summary/all_day.geojson"
         setAccept "application/json"

  sendRequest c q emptyBody

  x <- receiveResponse c jsonHandler
  print x

  closeConnection c

jsonHandler :: Response -> InputStream S.ByteString -> IO (Maybe Feed)
jsonHandler p i = do
  chunks <- Streams.toList i
  let feed = decode (BL.fromChunks chunks) :: Maybe Feed
  return feed

HTTPStreamsAeson2.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Aeson
import Data.Maybe
import Data.List
import Control.Applicative ((<$>), (<*>), empty)
import qualified System.IO.Streams as Streams
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
import qualified Data.ByteString.Lazy.Char8 as BL
import Network.Http.Client

--
-- Types
--

-- feed metadata
data MetaData = MetaData {
      metadataUrl :: String,
      metadataTitle :: String,
      metadataGenerated :: Integer
} deriving (Show)

instance FromJSON MetaData where
    parseJSON (Object v) = MetaData <$>
                           v .: "url" <*>
                           v .: "title" <*>
                           v .: "generated"
    parseJSON _ = empty

-- feature properties
data Properties = Properties {
       propertiesDetail :: String,
       propertiesMagnitude :: Float
} deriving (Show)

instance FromJSON Properties where
    parseJSON (Object v) = Properties <$>
                           v .: "detail" <*>
                           v .: "mag"
    parseJSON _ = empty

-- the feature itself
data Feature = Feature {
      featureId :: String,
      featureProperties :: Properties
} deriving (Show)

instance FromJSON Feature where
    parseJSON (Object v) = Feature <$>
                           v .: "id" <*>
                           v .: "properties"
    parseJSON _ = empty

-- and our top level feed container type
data Feed = Feed {
      feedMetadata :: MetaData,
      feedFeatures :: [Feature]
} deriving (Show)

instance FromJSON Feed where
    parseJSON (Object v) = Feed <$>
                           v .: "metadata" <*>
                           v .: "features"
    parseJSON _ = empty

data TimeFrame = Hour | Day | Week | Month

instance Show TimeFrame where
    show Hour = "hour"
    show Day = "day"
    show Week = "week"
    show Month = "month"

data Magnitude = Significant | M45 | M25 | M10 | All

instance Show Magnitude where
    show Significant = "significant"
    show M45 = "4.5"
    show M25 = "2.5"
    show M10 = "1.0"
    show All = "all"

--
-- Helpers
--
jsonHandler :: Response -> Streams.InputStream S.ByteString -> IO (Maybe Feed)
jsonHandler p i = do
  chunks <- Streams.toList i
  let feed = decode (BL.fromChunks chunks) :: Maybe Feed
  return feed

-- from http://tinyurl.com/krtjfjv
mean l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l
         in realToFrac(t)/realToFrac(n)

range l = subtract h t
    where s = sort l
          t = last s
          h = head s

--
-- API
--
fetchQuakes :: Magnitude -> TimeFrame -> IO (Maybe Feed)
fetchQuakes m t = do
  c <- openConnection "earthquake.usgs.gov" 80

  q <- buildRequest $ do
                    http GET uri
                    setAccept "application/json"
  sendRequest c q emptyBody
  x <- receiveResponse c jsonHandler
  closeConnection c
  return x
  where uri = SC.pack $ "/earthquakes/feed/v1.0/summary/" ++ (show m) ++ "_" ++ (show t) ++ ".geojson"

-- fetch the quakes for the week and print out the mean and range of magnitudes
main :: IO ()
main = do
  feeds <- fetchQuakes All Week
  case feeds of
    Nothing -> error "feed not found"
    Just f -> do
               print mean'
               print range'
              where magnitudes = map (propertiesMagnitude . featureProperties) $ feedFeatures f
                    mean' = mean magnitudes
                    range' = range magnitudes

HTTPStreamsAeson3.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.Aeson
import Data.Maybe
import Data.List
import Control.Applicative ((<$>), (<*>), empty)
import qualified System.IO.Streams as Streams
import System.IO.Streams.Attoparsec (parseFromStream)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
import qualified Data.ByteString.Lazy.Char8 as BL
import Network.Http.Client

--
-- Types
--

-- feed metadata
data MetaData = MetaData {
      metadataUrl :: String,
      metadataTitle :: String,
      metadataGenerated :: Integer
} deriving (Show)

instance FromJSON MetaData where
    parseJSON (Object v) = MetaData <$>
                           v .: "url" <*>
                           v .: "title" <*>
                           v .: "generated"
    parseJSON _ = empty

-- feature properties
data Properties = Properties {
       propertiesDetail :: String,
       propertiesMagnitude :: Float
} deriving (Show)

instance FromJSON Properties where
    parseJSON (Object v) = Properties <$>
                           v .: "detail" <*>
                           v .: "mag"
    parseJSON _ = empty

-- the feature itself
data Feature = Feature {
      featureId :: String,
      featureProperties :: Properties
} deriving (Show)

instance FromJSON Feature where
    parseJSON (Object v) = Feature <$>
                           v .: "id" <*>
                           v .: "properties"
    parseJSON _ = empty

-- and our top level feed container type
data Feed = Feed {
      feedMetadata :: MetaData,
      feedFeatures :: [Feature]
} deriving (Show)

instance FromJSON Feed where
    parseJSON (Object v) = Feed <$>
                           v .: "metadata" <*>
                           v .: "features"
    parseJSON _ = empty

data TimeFrame = Hour | Day | Week | Month

instance Show TimeFrame where
    show Hour = "hour"
    show Day = "day"
    show Week = "week"
    show Month = "month"

data Magnitude = Significant | M45 | M25 | M10 | All

instance Show Magnitude where
    show Significant = "significant"
    show M45 = "4.5"
    show M25 = "2.5"
    show M10 = "1.0"
    show All = "all"

--
-- Helpers
--
parseJSONFromStream :: FromJSON a => Streams.InputStream S.ByteString -> IO (Result a)
parseJSONFromStream = parseFromStream $ fmap fromJSON json 

-- from http://tinyurl.com/krtjfjv
mean l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l
         in realToFrac(t)/realToFrac(n)

range l = subtract h t
    where s = sort l
          t = last s
          h = head s

buildURI :: Magnitude -> TimeFrame -> SC.ByteString
buildURI m t = SC.pack $ "/earthquakes/feed/v1.0/summary/" ++ (show m) ++ "_" ++ (show t) ++ ".geojson"

--
-- API
--
fetchQuakes :: Magnitude -> TimeFrame -> IO (Result Feed)
fetchQuakes m t = do
  withConnection (openConnection "earthquake.usgs.gov" 80) $
                     \c -> do
                       q <- buildRequest $ do
                              http GET $ buildURI m t
                              setAccept "application/json"
                       sendRequest c q emptyBody
                       receiveResponse c (\_ i -> parseJSONFromStream i :: IO (Result Feed))

-- fetch the quakes for the week and print out the mean and range of magnitudes
main :: IO ()
main = do
  feeds <- fetchQuakes All Week
  case feeds of
       Error e -> print e
       Success f -> do
                      print mean'
                      print range'
                    where magnitudes = map (propertiesMagnitude . featureProperties) $ feedFeatures f
                          mean' = mean magnitudes
                          range' = range magnitudes

HTTPStreamsSimple.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified Data.ByteString as S
import Network.Http.Client

main :: IO ()
main = do
  get "http://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/all_day.geojson" debugHandler

HTTPStreamsSimple2.hs

{-# LANGUAGE OverloadedStrings #-}

import System.IO.Streams (InputStream, OutputStream, stdout)
import qualified System.IO.Streams as Streams
import qualified Data.ByteString as S
import Network.Http.Client

main :: IO ()
main = do
  get "http://earthquake.usgs.gov/earthquakes/feed/v1.0/summary/all_day.geojson" justTheBodyHandler

justTheBodyHandler :: Response -> InputStream S.ByteString -> IO ()
justTheBodyHandler p i = do
  Streams.connect i stdout