Haskell Quiz/Cat2Rafb/Solution Burton

< Haskell Quiz | Cat2Rafb

-- post the contents of stdin to hpaste.org
-- 
-- e.g. $ cat Cat2hpaste.hs | ./cat2hpaste
 
 
import Network.HTTP
import Network.URI
import System
import System.IO 
import System.Time
import Data.Maybe
 
main = do contents <- getContents
          title    <- getClockTime
          url      <- post (show title) "cat2hpaste" contents
          putStrLn url
 
err :: String -> IO a
err msg = do hPutStrLn stderr msg
	     exitFailure
 
post :: String -> String -> String -> IO String
post title nick content = do 
  eresp <- simpleHTTP postRequest
  resp <- handleE (err . show) eresp
  let locs = retrieveHeaders HdrLocation resp
  return (show (head locs))
    where postRequest :: Request
          postRequest = 
              Request { rqURI     = fromJust $ parseURI "http://hpaste.org/new",
                        rqMethod  = POST,
                        rqHeaders = [uaHeader,
                                     Header HdrContentLength (show $ length body),
                                     Header HdrAccept        ("text/xml,application/xml,application/xhtml+xml,text/html"),
                                     Header HdrContentType   "application/x-www-form-urlencoded" ],
                        rqBody    = body }
          body = urlEncodeVars [ ("content", content),
                                 ("nick", nick),
                                 ("title", title)]
 
uaHeader :: Header
uaHeader = Header HdrUserAgent "Firefox/1.5.0.4"
 
handleE :: Monad m => (ConnError -> m a) -> Either ConnError a -> m a
handleE h (Left e) = h e
handleE _ (Right v) = return v

Recent content is available under a simple permissive license.