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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
|
module CPM.Repository.Select
( searchNameSynopsisModules
, searchExportedModules, searchExecutable
, getRepositoryWithNameVersionSynopsis
, getRepositoryWithNameVersionCategory
, getBaseRepository
, getRepoForPackageSpec
, getRepoForPackages
, getAllPackageVersions, getPackageVersion
, addPackageToRepositoryCache
, updatePackageInRepositoryCache
)
where
import Char ( toLower )
import Directory ( doesFileExist )
import List ( isInfixOf )
import ReadShowTerm
import Database.CDBI.ER
import Database.CDBI.Connection
import CPM.Config ( Config )
import CPM.ErrorLogger
import CPM.FileUtil ( ifFileExists )
import CPM.Repository.RepositoryDB
import CPM.Repository.CacheFile ( readRepository )
import CPM.Repository.CacheDB
import CPM.Package
import CPM.Repository
runQuery :: Config -> DBAction a -> IO a
runQuery cfg dbact = do
warnIfRepositoryOld cfg
let dbfile = repositoryCacheDB cfg
debugMessage $ "Reading repository database '" ++ dbfile ++ "'..."
result <- runQueryOnDB dbfile dbact
debugMessage $ "Finished reading repository database"
return result
searchNameSynopsisModules :: Config -> String -> IO [Package]
searchNameSynopsisModules cfg pat =
runQuery cfg $ liftM (map toPackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntrySynopsisColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria (Database.CDBI.ER.Or [Database.CDBI.ER.like (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (pattern)) ,Database.CDBI.ER.Or [Database.CDBI.ER.like (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnSynopsis 0) (Database.CDBI.ER.string (pattern)) ,Database.CDBI.ER.like (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnExportedModules 0) (Database.CDBI.ER.string (pattern))]]) Nothing)] [] Nothing)
where
pattern = "%" ++ pat ++ "%"
toPackage (nm,vs,syn,cmp) =
emptyPackage { name = nm
, version = pkgRead vs
, synopsis = syn
, compilerCompatibility = pkgRead cmp
}
searchExportedModules :: Config -> String -> IO [Package]
searchExportedModules cfg pat =
(queryDBorCache cfg True $
liftM (pkgsToRepository . map toPackage)
(Database.CDBI.ER.getColumnFiveTuple [] [Database.CDBI.ER.FiveCS Database.CDBI.ER.All (Database.CDBI.ER.fiveCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntrySynopsisColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryExportedModulesColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria (Database.CDBI.ER.like (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnExportedModules 0) (Database.CDBI.ER.string (pattern))) Nothing)] [] Nothing)
) >>= return . filterExpModules . allPackages
where
pattern = "%" ++ pat ++ "%"
lpat = map toLower pat
filterExpModules = filter (\p -> any (\m -> lpat `isInfixOf` (map toLower m))
(exportedModules p))
toPackage (nm,vs,syn,cmp,exps) =
emptyPackage { name = nm
, version = pkgRead vs
, synopsis = syn
, compilerCompatibility = pkgRead cmp
, exportedModules = pkgRead exps
}
searchExecutable :: Config -> String -> IO [Package]
searchExecutable cfg pat =
(queryDBorCache cfg True $
liftM (pkgsToRepository . map toPackage)
(Database.CDBI.ER.getColumnFiveTuple [] [Database.CDBI.ER.FiveCS Database.CDBI.ER.All (Database.CDBI.ER.fiveCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntrySynopsisColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryExecutableSpecColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria (Database.CDBI.ER.like (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnExecutableSpec 0) (Database.CDBI.ER.string (pattern))) Nothing)] [] Nothing)
) >>= return . filterExec . allPackages
where
pattern = "%" ++ pat ++ "%"
lpat = map toLower pat
filterExec = filter (\p -> lpat `isInfixOf` (map toLower $ execOfPackage p))
toPackage (nm,vs,syn,cmp,exec) =
emptyPackage { name = nm
, version = pkgRead vs
, synopsis = syn
, compilerCompatibility = pkgRead cmp
, executableSpec = pkgRead exec
}
getRepositoryWithNameVersionSynopsis :: Config -> IO Repository
getRepositoryWithNameVersionSynopsis cfg = queryDBorCache cfg True $
liftM (pkgsToRepository . map toPackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntrySynopsisColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria Database.CDBI.ER.None Nothing)] [] Nothing)
where
toPackage (nm,vs,syn,cmp) =
emptyPackage { name = nm
, version = pkgRead vs
, synopsis = syn
, compilerCompatibility = pkgRead cmp
}
getRepositoryWithNameVersionCategory :: Config -> IO Repository
getRepositoryWithNameVersionCategory cfg = queryDBorCache cfg True $
liftM (pkgsToRepository . map toPackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCategoryColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria Database.CDBI.ER.None Nothing)] [] Nothing)
where
toPackage (nm,vs,cats,cmp) =
emptyPackage { name = nm
, version = pkgRead vs
, category = pkgRead cats
, compilerCompatibility = pkgRead cmp
}
getBaseRepository :: Config -> IO Repository
getBaseRepository cfg = queryDBorCache cfg False $
liftM (pkgsToRepository . map toBasePackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryDependenciesColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria Database.CDBI.ER.None Nothing)] [] Nothing)
toBasePackage :: (String,String,String,String) -> Package
toBasePackage (nm,vs,deps,cmp) =
emptyPackage { name = nm
, version = pkgRead vs
, dependencies = pkgRead deps
, compilerCompatibility = pkgRead cmp
}
getRepoPackagesWithName :: Config -> String -> IO Repository
getRepoPackagesWithName cfg pn = queryDBorCache cfg False $
liftM (pkgsToRepository . map toBasePackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryDependenciesColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria (Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (pn))) Nothing)] [] Nothing)
getRepoForPackageSpec :: Config -> Package -> IO Repository
getRepoForPackageSpec cfg pkgspec =
getRepoForPackages cfg (name pkgspec : dependencyNames pkgspec)
getRepoForPackages :: Config -> [String] -> IO Repository
getRepoForPackages cfg pkgnames = do
dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists
then do warnIfRepositoryOld cfg
let dbfile = repositoryCacheDB cfg
debugMessage $ "Reading repository database '" ++ dbfile ++ "'..."
repo <- queryPackagesFromDB pkgnames [] []
debugMessage $ "Finished reading repository database"
return repo
else readRepository cfg False
where
queryPackagesFromDB [] _ pkgs = return $ pkgsToRepository pkgs
queryPackagesFromDB (pn:pns) lpns pkgs
| pn `elem` lpns = queryPackagesFromDB pns lpns pkgs
| otherwise = do
debugMessage $ "Reading package versions of " ++ pn
pnpkgs <- queryPackage pn
let newdeps = concatMap dependencyNames pnpkgs
queryPackagesFromDB (newdeps++pns) (pn:lpns) (pnpkgs++pkgs)
queryPackage pn = runQueryOnDB (repositoryCacheDB cfg) $
liftM (map toBasePackage)
(Database.CDBI.ER.getColumnFourTuple [] [Database.CDBI.ER.FourCS Database.CDBI.ER.All (Database.CDBI.ER.fourCol (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryNameColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryVersionColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryDependenciesColDesc 0 Database.CDBI.ER.none) (Database.CDBI.ER.singleCol CPM.Repository.RepositoryDB.indexEntryCompilerCompatibilityColDesc 0 Database.CDBI.ER.none)) (Database.CDBI.ER.TC CPM.Repository.RepositoryDB.indexEntryTable 0 Nothing) (Database.CDBI.ER.Criteria (Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (pn))) Nothing)] [] Nothing)
getAllPackageVersions :: Config -> String -> Bool -> IO [Package]
getAllPackageVersions cfg pkgname pre = do
repo <- getRepoPackagesWithName cfg pkgname
return (findAllVersions repo pkgname pre)
getPackageVersion :: Config -> String -> Version -> IO (Maybe Package)
getPackageVersion cfg pkgname ver = do
repo <- getRepoPackagesWithName cfg pkgname
return (findVersion repo pkgname ver)
queryDBorCache :: Config -> Bool -> DBAction Repository -> IO Repository
queryDBorCache cfg large dbaction = do
dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists then runQuery cfg dbaction
else readRepository cfg large
pkgRead :: String -> a
pkgRead = readUnqualifiedTerm ["CPM.Package","Prelude"]
addPackageToRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
addPackageToRepositoryCache cfg pkg = do
dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists then addPackagesToRepositoryDB cfg True [Left pkg]
else cleanRepositoryCache cfg >> succeedIO ()
updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
updatePackageInRepositoryCache cfg pkg = do
dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists then removePackageFromRepositoryDB cfg pkg >>
addPackagesToRepositoryDB cfg True [Left pkg]
else cleanRepositoryCache cfg >> succeedIO ()
removePackageFromRepositoryDB :: Config -> Package -> IO ()
removePackageFromRepositoryDB cfg pkg = runQuery cfg
(Database.CDBI.ER.deleteEntries CPM.Repository.RepositoryDB.indexEntry_CDBI_Description (Just (Database.CDBI.ER.And [Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (name pkg)) ,Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnVersion 0) (Database.CDBI.ER.string (showTerm (version pkg)))])))
|