Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 149 lines (131 sloc) 5.921 kb
0d1e32c @hiratara more samples
authored
1 module PodDB where
2
3 import Database.HDBC
4 import Database.HDBC.Sqlite3
5 import PodTypes
6 import Control.Monad(when)
7 import Data.List(sort)
8
9 -- | Initialize DB and return database Connection
10 connect :: FilePath -> IO Connection
11 connect fp =
12 do dbh <- connectSqlite3 fp
13 prepDB dbh
14 return dbh
15
16 {- | Prepare the database for our data.
17
18 We create two tables and ask the database engine to verify some pieces
19 of data consistency for us:
20
21 * castid and epid both are unique primary keys and must never be duplicated
22 * castURL also is unique
23 * In the episodes table, for a given podcast (epcast), there must be only
24 one instance of each given URL or episode ID
25 -}
26 prepDB :: IConnection conn => conn -> IO ()
27 prepDB dbh =
28 do tables <- getTables dbh
29 when (not ("podcasts" `elem` tables)) $
30 do run dbh "CREATE TABLE podcasts (\
31 \castid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\
32 \castURL TEXT NOT NULL UNIQUE)" []
33 return ()
34 when (not ("episodes" `elem` tables)) $
35 do run dbh "CREATE TABLE episodes (\
36 \epid INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT,\
37 \epcastid INTEGER NOT NULL,\
38 \epurl TEXT NOT NULL,\
39 \epdone INTEGER NOT NULL,\
40 \UNIQUE(epcastid, epurl),\
41 \UNIQUE(epcastid, epid))" []
42 return ()
43 commit dbh
44
45 {- | Adds a new podcast to the database. Ignores the castid on the
46 incoming podcast, and returns a new object with the castid populated.
47
48 An attempt to add a podcast that already exists is an error. -}
49 addPodcast :: IConnection conn => conn -> Podcast -> IO Podcast
50 addPodcast dbh podcast =
51 handleSql errorHandler $
52 do -- Insert the castURL into the table. The database
53 -- will automatically assign a cast ID.
54 run dbh "INSERT INTO podcasts (castURL) VALUES (?)"
55 [toSql (castURL podcast)]
56 -- Find out the castID for the URL we just added.
57 r <- quickQuery' dbh "SELECT castid FROM podcasts WHERE castURL = ?"
58 [toSql (castURL podcast)]
59 case r of
60 [[x]] -> return $ podcast {castId = fromSql x}
61 y -> fail $ "addPodcast: unexpected result: " ++ show y
62 where errorHandler e =
63 do fail $ "Error adding podcast; does this URL already exist?\n"
64 ++ show e
65
66 {- | Adds a new episode to the database.
67
68 Since this is done by automation, instead of by user request, we will
69 simply ignore requests to add duplicate episodes. This way, when we are
70 processing a feed, each URL encountered can be fed to this function,
71 without having to first look it up in the DB.
72
73 Also, we generally won't care about the new ID here, so don't bother
74 fetching it. -}
75 addEpisode :: IConnection conn => conn -> Episode -> IO ()
76 addEpisode dbh ep =
77 run dbh "INSERT OR IGNORE INTO episodes (epCastId, epURL, epDone) \
78 \VALUES (?, ?, ?)"
79 [toSql (castId . epCast $ ep), toSql (epURL ep),
80 toSql (epDone ep)]
81 >> return ()
82
83 {- | Modifies an existing podcast. Looks up the given podcast by
84 ID and modifies the database record to match the passed Podcast. -}
85 updatePodcast :: IConnection conn => conn -> Podcast -> IO ()
86 updatePodcast dbh podcast =
87 run dbh "UPDATE podcasts SET castURL = ? WHERE castId = ?"
88 [toSql (castURL podcast), toSql (castId podcast)]
89 >> return ()
90
91 {- | Modifies an existing episode. Looks it up by ID and modifies the
92 database record to match the given episode. -}
93 updateEpisode :: IConnection conn => conn -> Episode -> IO ()
94 updateEpisode dbh episode =
95 run dbh "UPDATE episodes SET epCastId = ?, epURL = ?, epDone = ? \
96 \WHERE epId = ?"
97 [toSql (castId . epCast $ episode),
98 toSql (epURL episode),
99 toSql (epDone episode),
100 toSql (epId episode)]
101 >> return ()
102
103 {- | Remove a podcast. First removes any episodes that may exist
104 for this podcast. -}
105 removePodcast :: IConnection conn => conn -> Podcast -> IO ()
106 removePodcast dbh podcast =
107 do run dbh "DELETE FROM episodes WHERE epcastid = ?"
108 [toSql (castId podcast)]
109 run dbh "DELETE FROM podcasts WHERE castid = ?"
110 [toSql (castId podcast)]
111 return ()
112
113 {- | Gets a list of all podcasts. -}
114 getPodcasts :: IConnection conn => conn -> IO [Podcast]
115 getPodcasts dbh =
116 do res <- quickQuery' dbh
117 "SELECT castid, casturl FROM podcasts ORDER BY castid" []
118 return (map convPodcastRow res)
119
120 {- | Get a particular podcast. Nothing if the ID doesn't match, or
121 Just Podcast if it does. -}
122 getPodcast :: IConnection conn => conn -> Integer -> IO (Maybe Podcast)
123 getPodcast dbh wantedId =
124 do res <- quickQuery' dbh
125 "SELECT castid, casturl FROM podcasts WHERE castid = ?"
126 [toSql wantedId]
127 case res of
128 [x] -> return (Just (convPodcastRow x))
129 [] -> return Nothing
130 x -> fail $ "Really bad error; more than one podcast with ID"
131
132 {- | Convert the result of a SELECT into a Podcast record -}
133 convPodcastRow :: [SqlValue] -> Podcast
134 convPodcastRow [svId, svURL] =
135 Podcast {castId = fromSql svId,
136 castURL = fromSql svURL}
137 convPodcastRow x = error $ "Can't convert podcast row " ++ show x
138
139 {- | Get all episodes for a particular podcast. -}
140 getPodcastEpisodes :: IConnection conn => conn -> Podcast -> IO [Episode]
141 getPodcastEpisodes dbh pc =
142 do r <- quickQuery' dbh
143 "SELECT epId, epURL, epDone FROM episodes WHERE epCastId = ?"
144 [toSql (castId pc)]
145 return (map convEpisodeRow r)
146 where convEpisodeRow [svId, svURL, svDone] =
147 Episode {epId = fromSql svId, epURL = fromSql svURL,
148 epDone = fromSql svDone, epCast = pc}
Something went wrong with that request. Please try again.