-
Notifications
You must be signed in to change notification settings - Fork 0
/
Database.hs
107 lines (89 loc) · 3.31 KB
/
Database.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
module Database
( Database
, databaseOpen
, databaseClose
, browseAdd
, browseFind
, browseFavorites
, browseSetTitle
, markAdd
, markList
) where
import Control.Concurrent.MVar
import Control.Monad
import Data.Array
import Data.Time.LocalTime (LocalTime)
import Database.HDBC
import Database.HDBC.PostgreSQL
import Util
type Query = MVar Statement
data Database
= Database
{ databaseConnection :: Connection
, databaseQueries :: Array QueryType Query
}
| NoDatabase
data QueryType
= BrowseAdd
| BrowseFavorites
| BrowseSetTitle
| MarkAdd
| MarkList
| BrowseFind
deriving (Show, Eq, Ord, Bounded, Enum, Ix)
queries :: [String]
queries =
[ "SELECT browse_add(?, ?)"
, "SELECT text(uri), title, last FROM (SELECT uri, title, last, \
\ row_number() OVER d AS i \
\ FROM browse WINDOW d AS (\
\ PARTITION BY (uri).domain ORDER BY last DESC ROWS BETWEEN UNBOUNDED PRECEDING AND UNBOUNDED FOLLOWING \
\ )) b WHERE i = 1 ORDER BY last DESC NULLS LAST"
, "UPDATE browse SET title = ? WHERE uri = ?::uri"
, "SELECT mark_add(?, ?)"
, "SELECT COALESCE(browse.uri, mark.uri), browse.title, browse.last \
\ FROM mark LEFT JOIN browse ON (mark.browse = browse.id) \
\ ORDER BY last DESC NULLS LAST"
, "SELECT COALESCE(browse.uri, mark.uri) \
\ FROM mark FULL JOIN browse ON (mark.browse = browse.id) \
\ WHERE text(coalesce(mark.uri, browse.uri)) LIKE '%' || ? || '%' \
\ ORDER BY mark.id IS NULL, browse.last DESC NULLS LAST LIMIT 1"
]
withQuery' :: Monoid a => QueryType -> (Statement -> IO a) -> Database -> IO a
withQuery' qt f Database{ databaseQueries = dq } = withMVar (dq ! qt) f
withQuery' _ _ NoDatabase = return mempty
withQuery :: Monoid a => QueryType -> (Statement -> IO a) -> Database -> IO a
withQuery qt f = withQuery' qt $ \q -> do
r <- f q
finish q
return r
execute_ :: Statement -> [SqlValue] -> IO ()
execute_ s = void . execute s
browseAdd :: String -> Maybe String -> Database -> IO ()
browseAdd u t = withQuery BrowseAdd (`execute_` [SqlString u, toSql t])
browseFind :: String -> Database -> IO (Maybe String)
browseFind u = withQuery BrowseFind $ \q -> do
execute_ q [SqlString u]
fmap (fromSql . head) =.< fetchRow q
browseFavorites :: Database -> IO [(String, Maybe String, Maybe LocalTime)]
browseFavorites = withQuery' BrowseFavorites $ \q -> do
execute_ q []
map (\[u,t,l] -> (fromSql u, fromSql t, fromSql l)) =.< fetchAllRows q
browseSetTitle :: String -> String -> Database -> IO ()
browseSetTitle u t = withQuery BrowseSetTitle (`execute_` [SqlString u, SqlString t])
markAdd :: String -> Bool -> Database -> IO ()
markAdd u f = withQuery MarkAdd (`execute_` [SqlString u, SqlBool f])
markList :: Database -> IO [(String, Maybe String, Maybe LocalTime)]
markList = withQuery' MarkList $ \q -> do
execute_ q []
map (\[u,t,l] -> (fromSql u, fromSql t, fromSql l)) =.< fetchAllRows q
databaseOpen :: Maybe String -> IO Database
databaseOpen (Just dbinfo) = do
c <- connectPostgreSQL' dbinfo
_ <- sRun c "SET search_path = uzbl, public, global" []
q <- mapM (newMVar <=< prepare c) queries
return $ Database c $ listArray (minBound, maxBound) q
databaseOpen Nothing = return NoDatabase
databaseClose :: Database -> IO ()
databaseClose Database{ databaseConnection = c } = disconnect c
databaseClose NoDatabase = return ()