1 files changed, 69 insertions, 0 deletions
diff --git a/CLPM/Repository.icl b/CLPM/Repository.icl
new file mode 100644
index 0000000..587715f
--- /dev/null
+++ b/CLPM/Repository.icl
@@ -0,0 +1,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]