1 files changed, 65 insertions, 0 deletions
diff --git a/ch23/23_a_1/PodDownload.hs b/ch23/23_a_1/PodDownload.hs
new file mode 100644
index 0000000..84e6ab7
--- /dev/null
+++ b/ch23/23_a_1/PodDownload.hs
@@ -0,0 +1,65 @@
+{-- snippet all --}
+module PodDownload where
+import PodTypes
+import PodDB
+import PodParser
+import Network.HTTP
+import System.IO
+import Database.HDBC
+import Data.Maybe
+import Network.URI
+
+{- | Download a URL.  (Left errorMessage) if an error,
+(Right doc) if success. -}
+downloadURL :: String -> IO (Either String String)
+downloadURL url =
+    do resp <- simpleHTTP request
+       case resp of
+         Left x -> return $ Left ("Error connecting: " ++ show x)
+         Right r -> 
+             case rspCode r of
+               (2,_,_) -> return $ Right (rspBody r)
+               (3,_,_) -> -- A HTTP redirect
+                 case findHeader HdrLocation r of
+                   Nothing -> return $ Left (show r)
+                   Just url -> downloadURL url
+               _ -> return $ Left (show r)
+    where request = Request {rqURI = uri,
+                             rqMethod = GET,
+                             rqHeaders = [],
+                             rqBody = ""}
+          uri = fromJust $ parseURI url
+
+{- | Update the podcast in the database. -}
+updatePodcastFromFeed :: IConnection conn => conn -> Podcast -> IO ()
+updatePodcastFromFeed dbh pc =
+    do resp <- downloadURL (castURL pc)
+       case resp of
+         Left x -> putStrLn x
+         Right doc -> updateDB doc
+
+    where updateDB doc = 
+              do mapM_ (addEpisode dbh) episodes
+                 commit dbh
+              where feed = parse doc (castURL pc)
+                    episodes = map (item2ep pc) (items feed)
+
+{- | Downloads an episode, returning a String representing
+the filename it was placed into, or Nothing on error. -}
+getEpisode :: IConnection conn => conn -> Episode -> IO (Maybe String)
+getEpisode dbh ep =
+    do resp <- downloadURL (epURL ep)
+       case resp of
+         Left x -> do putStrLn x
+                      return Nothing
+         Right doc -> 
+             do file <- openBinaryFile filename WriteMode
+                hPutStr file doc
+                hClose file
+                updateEpisode dbh (ep {epDone = True})
+                commit dbh
+                return (Just filename)
+          -- This function ought to apply an extension based on the filetype
+    where filename = "pod." ++ (show . castId . epCast $ ep) ++ "." ++ 
+                     (show (epId ep)) ++ ".mp3"
+{-- /snippet all --}