Difference between revisions of "Haskell Quiz/Cat2Rafb/Solution Burton"
< Haskell Quiz | Cat2Rafb
Jump to navigation
Jump to search
Jim Burton (talk | contribs) |
Jim Burton (talk | contribs) |
||
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