blob: 84e6ab784a7ea3250c32409d07ac63451c984709 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
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 --}
|
