-
Notifications
You must be signed in to change notification settings - Fork 0
/
DatabaseFunctions.hs
152 lines (137 loc) · 7.75 KB
/
DatabaseFunctions.hs
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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
module DatabaseFunctions where
import Database.HDBC
import qualified Data.ByteString as B
import Control.Monad (msum, mzero, MonadPlus)
import Control.Monad.Trans (MonadIO, liftIO)
import Web.Routes ( PathInfo(..), RouteT , showURL , runRouteT
, Site(..) , setDefault, mkSitePI )
import Happstack.Server (port , Response , ServerPartT, ok , toResponse
,simpleHTTP, nullConf , seeOther , dir , notFound
,seeOther , asContentType, serveFile , ToMessage(..) )
import Routing
import DataStructures
getThumbFromDb :: (IConnection d, MonadIO m, MonadPlus m) => d -> Int -> m (Maybe (String, B.ByteString))
getThumbFromDb db id = do
arts <- liftIO $ handleSqlError $
quickQuery' db "SELECT `thumb_mime`,`thumb` FROM `album_data` WHERE `album_id`= ?" [toSql id]
case arts of
([SqlNull,_]:_) -> return Nothing
([_,SqlNull]:_) -> return Nothing
([mime,bs]:_) ->
return $ Just ((fromSql mime),(fromSql bs))
_ -> mzero
getArtFromDb :: (IConnection d, MonadIO m, MonadPlus m) => d -> Int -> m (Maybe (String, B.ByteString))
getArtFromDb db id = do
arts <- liftIO $ handleSqlError $
quickQuery' db "SELECT `art_mime`,`art` FROM `album_data` WHERE `album_id`= ?" [toSql id]
case arts of
([SqlNull,_]:_) -> return Nothing
([_,SqlNull]:_) -> return Nothing
([mime,bs]:_) ->
return $ Just ((fromSql mime),(fromSql bs))
_ -> mzero
{-
albumQuery = "SELECT DISTINCT song.album,album.name,album.prefix,song.artist,artist.name,artist.prefix \
\FROM `song` \
\LEFT JOIN `album` \
\ON song.album=album.id \
\LEFT JOIN `artist` \
\ON song.artist=artist.id"
artistQuery = "SELECT artist.id,artist.name,artist.prefix FROM `artist`"
queryFilters :: String -> [(String,SqlValue)] -> (String,[SqlValue])
queryFilters sql [] = (sql, [])
queryFilters sql al = ((sql ++ (doWhere x) ++ ( concat $ map doFilter xs)), params)
where ((x:xs),params) = unzip al
doFilter [] = []
doFilter str = " AND " ++ str ++ "=?"
doWhere [] = []
doWhere str = " WHERE " ++ str ++ "=?"
getAlbumsFromDb :: (IConnection d) => d -> [(String,SqlValue)] -> RouteT Sitemap (ServerPartT IO) [Album]
getAlbumsFromDb db params = do
albums <- liftIO $ handleSqlError $ uncurry (quickQuery' db) (queryFilters albumQuery params)
case albums of
(x:xs) -> mapM albumFromDbRow albums
where albumFromDbRow [alid,albumname,albumpre,artid,artist,artistpre] = do
aurl <- (showURL (AlbumArt (AlbumId (fromSql alid))))
return Album { albumID = (fromSql alid)
, albumTitle = (formatWithPrefix (fromSql albumname) (fromSql albumpre))
, albumArtistID = (fromSql artid)
, albumArtistName = (formatWithPrefix (fromSql artist) (fromSql artistpre))
, albumArtUrl = aurl
}
_ -> mzero
getArtistsFromDb :: (IConnection d, MonadIO m, MonadPlus m) => d -> [(String,SqlValue)] -> m [Artist]
getArtistsFromDb db params = do
artists <- liftIO $ handleSqlError $ uncurry (quickQuery' db) (queryFilters artistQuery params)
case artists of
(x:xs) -> return $ map artistFromDbRow artists
where artistFromDbRow [id,artnam,artpre] =
Artist { artistID = (fromSql id)
, artistName = (formatWithPrefix (fromSql artnam) (fromSql artpre))
}
_ -> mzero
getArtistFromDb :: (IConnection d, MonadIO m, MonadPlus m) => d -> ArtistId -> m Artist
getArtistFromDb db (ArtistId id) = do
artists <- liftIO $ handleSqlError $
quickQuery' db "SELECT artist.name,artist.prefix \
\FROM `artist` \
\WHERE artist.id = ?" [toSql id]
case artists of
([artnam,artpre]:_) -> do
return Artist { artistID = id
, artistName = (formatWithPrefix (fromSql artnam) (fromSql artpre))
}
_ -> mzero
getAlbumFromDb :: (IConnection d) => d -> AlbumId -> RouteT Sitemap (ServerPartT IO) Album
getAlbumFromDb db albumid@(AlbumId id) = do
albums <- liftIO $ handleSqlError $
quickQuery' db "SELECT album.name,album.prefix,song.artist,artist.name,artist.prefix \
\FROM `song` \
\LEFT JOIN `album` \
\ON song.album=album.id \
\LEFT JOIN `artist` \
\ON song.artist=artist.id \
\WHERE song.album = ?" [toSql id]
case albums of
([nam,pre,artid,artnam,artpre]:_) -> do
aurl <- (showURL (AlbumArt albumid))
return Album { albumID = id
, albumTitle = (formatWithPrefix (fromSql nam) (fromSql pre))
, albumArtistID = (fromSql artid)
, albumArtistName = (formatWithPrefix (fromSql artnam) (fromSql artpre))
, albumArtUrl = aurl
}
_ -> mzero
getAlbumSongsFromDb :: (IConnection d) => d -> Int -> RouteT Sitemap (ServerPartT IO) [Song]
getAlbumSongsFromDb db id = do
songs <- liftIO $ handleSqlError $
quickQuery' db "SELECT song.id,song.title,song.track,song.album,album.name,album.prefix,artist.name,artist.prefix,song.time \
\FROM `song` \
\LEFT JOIN `album` \
\ON song.album=album.id \
\LEFT JOIN `artist` \
\ON song.artist=artist.id \
\WHERE song.album = ?" [toSql id]
case songs of
(x:xs) -> mapM songFromDbRow songs
where songFromDbRow [sid,title,track,albumid,albumname,albumpre,artist,artistpre,dur] = do
surl <- (showURL (Stream (SongId (fromSql sid) )))
return Song { songID = (fromSql sid)
, songName = (fromSql title)
, songTrack = (fromSql track)
, songUrl = surl
, songAlbumId = (fromSql albumid)
, songAlbumTitle = (formatWithPrefix (fromSql albumname) (fromSql albumpre))
, songArtistName = (formatWithPrefix (fromSql artist) (fromSql artistpre))
, songDuration = (fromSql dur)
}
_ -> mzero
getSongUrlFromDb :: (IConnection d, MonadIO m, MonadPlus m) => d -> Int -> m String
getSongUrlFromDb db id = do
songs <- liftIO $ handleSqlError $
quickQuery' db "SELECT `file` FROM `song` WHERE id = ?" [toSql id]
case songs of
([file]:_) ->
return (fromSql file)
_ -> mzero
-}