Difference between revisions of "Haskell Quiz/Cat2Rafb/Solution Burton"

From HaskellWiki
Jump to navigation Jump to search
 
 
Line 1: Line 1:
  +
<haskell>
 
-- post the contents of stdin to hpaste.org
 
-- post the contents of stdin to hpaste.org
 
--
 
--
Line 45: Line 46:
 
handleE h (Left e) = h e
 
handleE h (Left e) = h e
 
handleE _ (Right v) = return v
 
handleE _ (Right v) = return v
  +
</haskell>

Latest revision as of 01:00, 4 February 2007

-- 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