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

------------------------------------------------------------------------------
--- Some queries on the repository cache.
---
--- @author Michael Hanus
--- @version April 2018
------------------------------------------------------------------------------


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

--- Runs a query on the repository cache DB and show debug infos.
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

--- Returns the packages of the repository containing a given string
--- in the name, synopsis, or exported modules.
--- In each package, the name, version, synopsis, and compilerCompatibility
--- is set.
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
                 }

--- Returns the packages of the repository containing a given module
--- in the list of exported modules.
--- In each package, the name, version, synopsis, compilerCompatibility,
--- and exportedModules is set.
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 ++ "%"

  filterExpModules = filter (\p -> pat `elem` exportedModules p)

  toPackage (nm,vs,syn,cmp,exps) =
    emptyPackage { name = nm
                 , version = pkgRead vs
                 , synopsis = syn
                 , compilerCompatibility = pkgRead cmp
                 , exportedModules       = pkgRead exps
                 }

--- Returns the packages of the repository containing a given string
--- in the name of the executable.
--- In each package, the name, version, synopsis, compilerCompatibility,
--- and executableSpec is set.
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 ++ "%"
  s = map toLower pat

  filterExec = filter (\p -> s `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
                 }

--- Returns the complete repository where in each package
--- the name, version, synopsis, and compilerCompatibility is set.
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
                 }

--- Returns the complete repository where in each package
--- the name, version, category, and compilerCompatibility is set.
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
                 }

--- Returns the complete repository where in each package
--- the name, version, dependencies, and compilerCompatibility is set.
--- The information is read either from the cache DB or from the cache file.
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)


--- Translate the (Name|Version|Dependencies|CompilerCompatibility) columns
--- of the cache DB into a package where the name, version, dependencies,
--- and compilerCompatibility is set.
toBasePackage :: (String,String,String,String) -> Package
toBasePackage (nm,vs,deps,cmp) =
  emptyPackage { name = nm
               , version = pkgRead vs
               , dependencies = pkgRead deps
               , compilerCompatibility = pkgRead cmp
               }

--- Returns the repository containing only packages with a given name where
--- in each package the name, version, dependencies, and compilerCompatibility
--- is set.
--- The information is read either from the cache DB or from the cache file.
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)



--- Returns the repository containing all packages and dependencies
--- (in all versions) mentioned in the given package specification.
--- In each package the name, version, dependencies, and compilerCompatibility
--- is set.
--- The information is read either from the cache DB or from the cache file.
getRepoForPackageSpec :: Config -> Package -> IO Repository
getRepoForPackageSpec cfg pkgspec =
  getRepoForPackages cfg (name pkgspec : dependencyNames pkgspec)

--- Returns the repository containing only packages of the second argument
--- and all the packages on which they depend (including all versions).
--- In each package the name, version, dependencies, and compilerCompatibility
--- is set.
--- The information is read either from the cache DB or from the cache file.
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)



--- Retrieves all versions of a package with a given name from the repository.
---
--- @param cfg     - the current CPM configuration
--- @param pkgname - the package name to be retrieved
--- @param pre     - should pre-release versions be included?
getAllPackageVersions :: Config -> String -> Bool -> IO [Package]
getAllPackageVersions cfg pkgname pre = do
  repo <- getRepoPackagesWithName cfg pkgname
  return (findAllVersions repo pkgname pre)

--- Retrieves a package with a given name and version from the repository.
---
--- @param cfg     - the current CPM configuration
--- @param pkgname - the package name to be retrieved
--- @param ver     - the requested version of the package
getPackageVersion :: Config -> String -> Version -> IO (Maybe Package)
getPackageVersion cfg pkgname ver = do
  repo <- getRepoPackagesWithName cfg pkgname
  return (findVersion repo pkgname ver)


--- If the cache DB exists, run the DB query to get the repository,
--- otherwise read the (small or large) repository cache file.
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

--- Reads an unqualified Curry term w.r.t. the module `CPM.Package`.
pkgRead :: String -> a
pkgRead = readUnqualifiedTerm ["CPM.Package","Prelude"]

------------------------------------------------------------------------------
--- Adds a new package to the repository cache.
--- In the file-based implementation, we simply clean the cache files.
addPackageToRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
addPackageToRepositoryCache cfg pkg = do
  dbexists <- doesFileExist (repositoryCacheDB cfg)
  if dbexists then addPackagesToRepositoryDB cfg True [pkg]
              else cleanRepositoryCache cfg >> succeedIO ()

--- Updates an existing package in the repository cache.
--- In the file-based implementation, we simply clean the cache files.
updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
updatePackageInRepositoryCache cfg pkg = do
  dbexists <- doesFileExist (repositoryCacheDB cfg)
  if dbexists then removePackageFromRepositoryDB cfg pkg >>
                   addPackagesToRepositoryDB cfg True [pkg]
              else cleanRepositoryCache cfg >> succeedIO ()

--- Removes a package from the repository cache DB.
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)))])))



------------------------------------------------------------------------------