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
|
module CPM.Repository.Update
( addPackageToRepository, updateRepository
)
where
import Directory
import FilePath
import List ( isSuffixOf )
import System ( system )
import CPM.Config ( Config, packageInstallDir, packageIndexURLs
, repositoryDir )
import CPM.ErrorLogger
import CPM.Package
import CPM.Package.Helpers ( cleanPackage )
import CPM.FileUtil ( copyDirectory, inDirectory, quote
, recreateDirectory, removeDirectoryComplete )
import CPM.Repository
import CPM.Repository.CacheDB ( tryInstallRepositoryDB )
import CPM.Repository.Select ( addPackageToRepositoryCache
, updatePackageInRepositoryCache )
updateRepository :: Config -> Bool -> Bool -> Bool -> Bool -> ErrorLoggerIO ()
updateRepository cfg cleancache download usecache writecsv = toELM $ do
cleanRepositoryCache cfg
when cleancache $ do
debugMessage $ "Deleting global package cache: '" ++
packageInstallDir cfg ++ "'"
removeDirectoryComplete (packageInstallDir cfg)
debugMessage $ "Recreating package index: '" ++ repositoryDir cfg ++ "'"
if download
then do
recreateDirectory (repositoryDir cfg)
c <- inDirectory (repositoryDir cfg) (tryDownload (packageIndexURLs cfg))
if c == 0
then finishUpdate
else failIO $ "Failed to update package index, return code " ++ show c
else tryInstallRepositoryDB cfg usecache writecsv
where
tryDownload [] = return 1
tryDownload (url:urls) = do
c <- downloadCommand url
if c == 0 then return 0
else tryDownload urls
downloadCommand piurl
| ".git" `isSuffixOf` piurl
= execQuietCmd $ \q -> unwords ["git clone", q, quote piurl, "."]
| ".tar" `isSuffixOf` piurl
= do let tarfile = "INDEX.tar"
c1 <- showExecCmd $ unwords ["curl", "-s", "-o", tarfile, quote piurl]
c2 <- showExecCmd $ unwords ["tar", "-xf", tarfile]
removeFile tarfile
return (c1+c2)
| ".tar.gz" `isSuffixOf` piurl
= do let tarfile = "INDEX.tar.gz"
c1 <- showExecCmd $ unwords ["curl", "-s", "-o", tarfile, quote piurl]
c2 <- showExecCmd $ unwords ["tar", "-xzf", tarfile]
removeFile tarfile
return (c1+c2)
| otherwise
= do errorMessage $ "Unknown kind of package index URL: " ++ piurl
return 1
finishUpdate = do
setLastUpdate cfg
cleanRepositoryCache cfg
infoMessage "Successfully downloaded repository index"
tryInstallRepositoryDB cfg usecache writecsv
setLastUpdate :: Config -> IO ()
setLastUpdate cfg =
system (unwords ["touch", repositoryDir cfg </> "README.md"]) >> done
addPackageToRepository :: Config -> String -> Bool -> Bool -> ErrorLoggerIO ()
addPackageToRepository cfg pkgdir force cpdir = do
dirExists <- execIO $ doesDirectoryExist pkgdir
if dirExists
then do pkgSpec <- loadPackageSpecELM pkgdir
execIO $ copyPackage pkgSpec
logMsg Info $ "Package in directory '" ++ pkgdir ++
"' installed into local repository"
else logMsg Critical $ "Directory '" ++ pkgdir ++ "' does not exist."
where
copyPackage pkg = do
let pkgIndexDir = name pkg </> showVersion (version pkg)
pkgRepositoryDir = repositoryDir cfg </> pkgIndexDir
pkgInstallDir = packageInstallDir cfg </> packageId pkg
exrepodir <- doesDirectoryExist pkgRepositoryDir
when (exrepodir && not force) $ error $
"Package repository directory '" ++
pkgRepositoryDir ++ "' already exists!\n"
expkgdir <- doesDirectoryExist pkgInstallDir
when expkgdir $
if force then removeDirectoryComplete pkgInstallDir
else error $ "Package installation directory '" ++
pkgInstallDir ++ "' already exists!\n"
infoMessage $ "Create directory: " ++ pkgRepositoryDir
createDirectoryIfMissing True pkgRepositoryDir
copyFile (pkgdir </> "package.json") (pkgRepositoryDir </> "package.json")
when cpdir $ do
copyDirectory pkgdir pkgInstallDir
inDirectory pkgInstallDir $ runELM $ cleanPackage cfg Debug
if exrepodir then updatePackageInRepositoryCache cfg pkg
else addPackageToRepositoryCache cfg pkg
|