DownloadFileWithMonadTransformer.hs

-- DownloadFileWithMonadTransformer.hs
-- Inspired by:
-- http://www.haskell.org/haskellwiki/Monad_Transformers_Tutorial
-- http://stackoverflow.com/questions/11514671/haskell-network-http-incorrectly-downloading-image

import qualified Data.ByteString as B
import Network.HTTP
import Network.URI (parseURI)
import Control.Monad.Trans

newtype MaybeT m a = MaybeT {
 runMaybeT :: m (Maybe a)
}

instance Monad m => Monad (MaybeT m) where
 return x = MaybeT (return (Just x))
 MaybeT action >>= f =
  MaybeT $
   action >>= \result ->
   case result of
    Nothing -> return Nothing
    Just x -> runMaybeT (f x)

instance MonadTrans MaybeT where
 lift action = MaybeT $ action >>= \result -> return (Just result)

zeroResponse :: IO B.ByteString
zeroResponse = return $ B.empty

downloadWithMonadTransformer :: String -> MaybeT IO B.ByteString
downloadWithMonadTransformer url =
 return (parseURI url) >>= \parsingResult ->
 case parsingResult of
  (Just uri) ->
   lift (putStrLn $ "Fetching link: " ++ show uri) >>
   lift (simpleHTTP (defaultGETRequest_ uri)) >>= \http ->
   lift (getResponseCode http) >>= \responseCode ->
   if responseCode == (2,0,0) then
    lift (getResponseBody http)
   else
    (lift $ putStrLn $ "HTTP response had error code: " ++ show responseCode) >>
    (lift $ zeroResponse)
  Nothing ->
   (lift (putStrLn $ "Ill-formed link: " ++ url)) >>
   (lift $ zeroResponse)

downloadAndSaveWithMonadTransformer url filepath =
 (lift $ putStrLn "\nTrying to download and save:") >>
 downloadWithMonadTransformer url >>= \file ->
 if B.length file == 0 then
  return ()
 else
  lift (putStrLn $ "Writing file: " ++ filepath) >>
  lift (B.writeFile filepath file)

main =
 runMaybeT (downloadAndSaveWithMonadTransformer "http://www.irregularwebcomic.net/comics/irreg2557.jpg" "irreg2557 - with monad transformer.jpg") >>
 runMaybeT (downloadAndSaveWithMonadTransformer "http://www.irregularwebcomic.net/comics/inexistent.html" "irreg2557 - with monad transformer.jpg") >>
 runMaybeT (downloadAndSaveWithMonadTransformer "illformed.net/error.txt" "error.txt")