Haskell Quiz/Cat2Rafb/Solution Burton

From HaskellWiki
< Haskell Quiz‎ | Cat2Rafb
Revision as of 00:59, 4 February 2007 by Jim Burton (talk | contribs)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
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