Spreadsheet-like example.

Sheet.hs

{-# LANGUAGE OverloadedStrings #-}

module Sheet where

import qualified Data.Map as M
import Text.PrettyPrint.Boxes
import Data.List

type Row a = M.Map Key a
type Key = String

-- Utilities

transformRows :: [Row a] -> M.Map Key [Maybe a]
transformRows rs = foldl (\xs key -> M.insert key (ofKey key rs) xs) M.empty keys
                  where
                    keys :: [Key]
                    keys = nub $ foldl (\xs x -> xs ++ (M.keys x)) [] (rs)

                    ofKey :: Key -> [Row a] -> [Maybe a]
                    ofKey key rs = map (M.lookup key) rs

mkBoxes :: (Maybe a -> String) -> M.Map Key [Maybe a] -> Box
mkBoxes unMaybe rs = hsep 2 left (map (vcat left . map (text)) rows)
             where
              rows :: [[String]]
              rows = M.foldlWithKey app [] rs
              -- app :: [[String]] -> Key -> [Maybe a] -> [[String]]
              app xs k vs = xs ++ [k:(map unMaybe vs)]

printBoxes u x = do
  printBox $ mkBoxes u $ transformRows x

SpreadsheetExample.hs

{-# LANGUAGE OverloadedStrings #-}
import Sheet

import qualified Data.Map as M
import Data.Aeson
import Network.Curl
import Data.Aeson.Types
import Data.Maybe


mapRows :: [Row a] -> [Row a]
mapRows = map $ M.filterWithKey $ \k v -> k == "subreddit" || k == "id" || k == "title"

reduceRows :: [Row a] -> [Row a]
reduceRows = id

-- show presentation
maxlen = 20

unMaybeShow :: Maybe Value -> String
unMaybeShow (Just (String s)) = fmt . show $ s
                                where
                                  fmt x = if (length x > maxlen + 3) then
                                     take maxlen x ++ "..."
                                  else
                                     x
unMaybeShow _ = "-"


reddit_lookup rx = do
  d <- rx .: "data"
  c <- d .: "children"
  return c

-- Reddit example:
main = do
  (_, str) <- curlGetString_ "http://www.reddit.com/.json" []
  (Just rx) <- return $ decode str

  let xs = map (\x -> fromJust (parseMaybe (.: "data") x)) $ fromJust $ parseMaybe reddit_lookup rx :: [Row Value]

  printHeaders $ transformRows $ xs
  printBoxes unMaybeShow $ reduceRows $ mapRows xs

printHeaders map = do
  putStrLn "Keys"
  print $ M.keys map