Haskell Quiz/Cat2Rafb/Solution Burton

From HaskellWiki
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
-- 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