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

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