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
|
implementation module CLPM.Repository
import StdBool
import StdClass
from StdFunc import flip, o
import StdOverloaded
import TCPIP
import Control.Applicative
import Control.Monad
import Data.Error
from Data.Func import $
import Data.Functor
import Data.Maybe
import Data.Tuple
import Internet.HTTP
from Text import instance + String
import Text.JSON
import CLPM.Package
derive JSONDecode RepositoryItem, RepositoryItemVersion
getRepository :: Url *World -> *(MaybeErrorString Repository, *World)
getRepository repo w
# (ip,w) = lookupIPAddress repo w
| isNothing ip
= (Error $ "DNS lookup for " + repo + " failed.", w)
# (Just ip) = ip
# (rpt,chan,w) = connectTCP_MT (Just TIMEOUT) (ip, PORT) w
| rpt == TR_Expired
= (Error $ "Connection to " + repo + " timed out.", w)
| rpt == TR_NoSuccess
= (Error $ "Could not connect to " + repo + ".", w)
# (Just {sChannel,rChannel}) = chan
# (rpt,i,sChannel,w) = send_MT (Just TIMEOUT) req sChannel w
| rpt <> TR_Success
= (Error $ "Could not request repository from " + repo + ".", w)
# (resp,rChannel,w) = appFst3 (parseResponse o toString) $ receive rChannel w
| isNothing resp
= (Error $ "Server did not respond with HTTP.", w)
# repo = fromJSON $ fromString (fromJust resp).rsp_data
| isNothing repo
= (Error $ "Server did not return a repository.", w)
# w = closeChannel sChannel (closeRChannel rChannel w)
= (Ok $ fromJust repo, w)
where
req = toByteSeq
{ newHTTPRequest
& req_path = "/list.php"
, server_name = REPOSITORY
}
getVersions :: (PackageName Repository -> [RepositoryItemVersion])
getVersions = flip (getvs [])
where
getvs :: [RepositoryItemVersion] Repository PackageName -> [RepositoryItemVersion]
getvs vs [] p = vs
getvs vs [i:r] p
| i.RepositoryItem.name == p = getvs (vs ++ i.RepositoryItem.versions) r p
| otherwise = getvs vs r p
resolve :: PackageName VersionRequirement Repository -> [RepositoryItemVersion]
resolve p req rep = [v \\ ri <- rep, v <- ri.versions
| ri.RepositoryItem.name == p && satisfies req v.RepositoryItemVersion.version]
|
