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
|
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.FetchUtils
-- Copyright : (c) David Himmelstrup 2005
-- Duncan Coutts 2011
-- License : BSD-like
--
-- Maintainer : cabal-devel@gmail.com
-- Stability : provisional
-- Portability : portable
--
-- Functions for fetching packages
-----------------------------------------------------------------------------
module Distribution.Client.FetchUtils (
-- * fetching packages
fetchPackage,
isFetched,
checkFetched,
-- ** specifically for repo packages
fetchRepoTarball,
-- * fetching other things
downloadIndex,
) where
import Distribution.Client.Types
import Distribution.Client.HttpUtils
( downloadURI, isOldHackageURI, DownloadResult(..) )
import Distribution.Package
( PackageId, packageName, packageVersion )
import Distribution.Simple.Utils
( notice, info, setupMessage )
import Distribution.Text
( display )
import Distribution.Verbosity
( Verbosity )
import Data.Maybe
import System.Directory
( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
import System.IO
( openTempFile, hClose )
import System.FilePath
( (</>), (<.>) )
import qualified System.FilePath.Posix as FilePath.Posix
( combine, joinPath )
import Network.URI
( URI(uriPath) )
-- ------------------------------------------------------------
-- * Actually fetch things
-- ------------------------------------------------------------
-- | Returns @True@ if the package has already been fetched
-- or does not need fetching.
--
isFetched :: PackageLocation (Maybe FilePath) -> IO Bool
isFetched loc = case loc of
LocalUnpackedPackage _dir -> return True
LocalTarballPackage _file -> return True
RemoteTarballPackage _uri local -> return (isJust local)
RepoTarballPackage repo pkgid _ -> doesFileExist (packageFile repo pkgid)
checkFetched :: PackageLocation (Maybe FilePath)
-> IO (Maybe (PackageLocation FilePath))
checkFetched loc = case loc of
LocalUnpackedPackage dir ->
return (Just $ LocalUnpackedPackage dir)
LocalTarballPackage file ->
return (Just $ LocalTarballPackage file)
RemoteTarballPackage uri (Just file) ->
return (Just $ RemoteTarballPackage uri file)
RepoTarballPackage repo pkgid (Just file) ->
return (Just $ RepoTarballPackage repo pkgid file)
RemoteTarballPackage _uri Nothing -> return Nothing
RepoTarballPackage repo pkgid Nothing -> do
let file = packageFile repo pkgid
exists <- doesFileExist file
if exists
then return (Just $ RepoTarballPackage repo pkgid file)
else return Nothing
-- | Fetch a package if we don't have it already.
--
fetchPackage :: Verbosity
-> PackageLocation (Maybe FilePath)
-> IO (PackageLocation FilePath)
fetchPackage verbosity loc = case loc of
LocalUnpackedPackage dir ->
return (LocalUnpackedPackage dir)
LocalTarballPackage file ->
return (LocalTarballPackage file)
RemoteTarballPackage uri (Just file) ->
return (RemoteTarballPackage uri file)
RepoTarballPackage repo pkgid (Just file) ->
return (RepoTarballPackage repo pkgid file)
RemoteTarballPackage uri Nothing -> do
path <- downloadTarballPackage uri
return (RemoteTarballPackage uri path)
RepoTarballPackage repo pkgid Nothing -> do
local <- fetchRepoTarball verbosity repo pkgid
return (RepoTarballPackage repo pkgid local)
where
downloadTarballPackage uri = do
notice verbosity ("Downloading " ++ show uri)
tmpdir <- getTemporaryDirectory
(path, hnd) <- openTempFile tmpdir "cabal-.tar.gz"
hClose hnd
_ <- downloadURI verbosity uri path
return path
-- | Fetch a repo package if we don't have it already.
--
fetchRepoTarball :: Verbosity -> Repo -> PackageId -> IO FilePath
fetchRepoTarball verbosity repo pkgid = do
fetched <- doesFileExist (packageFile repo pkgid)
if fetched
then do info verbosity $ display pkgid ++ " has already been downloaded."
return (packageFile repo pkgid)
else do setupMessage verbosity "Downloading" pkgid
downloadRepoPackage
where
downloadRepoPackage = case repoKind repo of
Right LocalRepo -> return (packageFile repo pkgid)
Left remoteRepo -> do
let uri = packageURI remoteRepo pkgid
dir = packageDir repo pkgid
path = packageFile repo pkgid
createDirectoryIfMissing True dir
_ <- downloadURI verbosity uri path
return path
-- | Downloads an index file to [config-dir/packages/serv-id].
--
downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO DownloadResult
downloadIndex verbosity repo cacheDir = do
let uri = (remoteRepoURI repo) {
uriPath = uriPath (remoteRepoURI repo)
`FilePath.Posix.combine` "00-index.tar.gz"
}
path = cacheDir </> "00-index" <.> "tar.gz"
createDirectoryIfMissing True cacheDir
downloadURI verbosity uri path
-- ------------------------------------------------------------
-- * Path utilities
-- ------------------------------------------------------------
-- | Generate the full path to the locally cached copy of
-- the tarball for a given @PackageIdentifer@.
--
packageFile :: Repo -> PackageId -> FilePath
packageFile repo pkgid = packageDir repo pkgid
</> display pkgid
<.> "tar.gz"
-- | Generate the full path to the directory where the local cached copy of
-- the tarball for a given @PackageIdentifer@ is stored.
--
packageDir :: Repo -> PackageId -> FilePath
packageDir repo pkgid = repoLocalDir repo
</> display (packageName pkgid)
</> display (packageVersion pkgid)
-- | Generate the URI of the tarball for a given package.
--
packageURI :: RemoteRepo -> PackageId -> URI
packageURI repo pkgid | isOldHackageURI (remoteRepoURI repo) =
(remoteRepoURI repo) {
uriPath = FilePath.Posix.joinPath
[uriPath (remoteRepoURI repo)
,display (packageName pkgid)
,display (packageVersion pkgid)
,display pkgid <.> "tar.gz"]
}
packageURI repo pkgid =
(remoteRepoURI repo) {
uriPath = FilePath.Posix.joinPath
[uriPath (remoteRepoURI repo)
,"package"
,display pkgid <.> "tar.gz"]
}
|
