From 40366fcf8b59659b2fa341b6ae1a5c5e0f97ab5a Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 6 Jul 2023 08:39:07 +0800 Subject: [PATCH] Better types for repositories WIP --- .../src/Distribution/Client/IndexUtils.hs | 4 +- .../src/Distribution/Client/Types/Repo.hs | 74 +++++++++++++++++++ 2 files changed, 77 insertions(+), 1 deletion(-) diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index 5958deca553..563dd525bd7 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -421,6 +421,7 @@ data RepoData = RepoData -- All the 'SourcePackage's are marked as having come from the given 'Repo'. -- -- This is a higher level wrapper used internally in cabal-install. +-- TODO: readRepoIndex :: Verbosity -> RepoContext @@ -759,10 +760,11 @@ indexFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "tar" cacheFile :: Index -> FilePath cacheFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "cache" -timestampFile :: Index -> FilePath +timestampFile :: Repo -> FilePath timestampFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "timestamp" -- | Return 'True' if 'Index' uses 01-index format (aka secure repo) +-- is01Repo ?? is01Index :: Index -> Bool is01Index (RepoIndex _ repo) = case repo of RepoSecure{} -> True diff --git a/cabal-install/src/Distribution/Client/Types/Repo.hs b/cabal-install/src/Distribution/Client/Types/Repo.hs index b5606725432..7f577a02ee6 100644 --- a/cabal-install/src/Distribution/Client/Types/Repo.hs +++ b/cabal-install/src/Distribution/Client/Types/Repo.hs @@ -1,4 +1,8 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} module Distribution.Client.Types.Repo ( -- * Remote repository @@ -31,6 +35,11 @@ import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp import Distribution.Client.Types.RepoName +import Distribution.Make (Dependency) +import qualified Data.ByteString as BSS +import Distribution.Types.GenericPackageDescription +import Distribution.Client.IndexUtils.Timestamp +import Distribution.Client.IndexUtils.IndexState (RepoIndexState) ------------------------------------------------------------------------------- -- Remote repository @@ -175,6 +184,71 @@ data Repo instance Binary Repo instance Structured Repo +-- Repo -> Index (~ tarball) -> ?IndexState -> Cache' +-- LocalNoIndex -> () -> () -> Cache' (RepoIndexState r) +-- RemoteRepo -> Tarball -> () -> CacheWithNoTimestamp +-- SecureRepo -> HackageSecurity -> IndexStateInfo -> CacheWithTimestamp + +data PackageId +data BlockNo +data BuildTreeRefType +data IndexStateInfo + +data NoTimestamp +data NoIndexState + +newtype SecureRepo = SecureRepo RemoteRepo + +data HasIndexState +data HasNoIndexState + +class IsCache c where + +class (IsCache (Cache r)) => IsRepo r where + type RepoHasIndexState r + type Cache r + +instance IsCache NoIndexCache +instance IsCache (IndexCache Timestamp) +instance IsCache (IndexCache NoTimestamp) + +instance IsRepo LocalRepo where + type RepoHasIndexState LocalRepo = NoIndexState + type Cache LocalRepo = NoIndexCache + +instance IsRepo RemoteRepo where + type RepoHasIndexState RemoteRepo = NoIndexState + type Cache RemoteRepo = IndexCache NoTimestamp + +instance IsRepo SecureRepo where + type RepoHasIndexState SecureRepo = IndexStateInfo + type Cache SecureRepo = IndexCache Timestamp + +data IndexCache ts = IndexCache + { cacheHeadTs :: ts + , cacheEntries :: [IndexCacheEntry ts] + } + +data IndexCacheEntry ts + = CachePackageId PackageId !BlockNo !ts + | CachePreference Dependency !BlockNo !ts + | CacheBuildTreeRef !BuildTreeRefType !BlockNo + +newtype NoIndexCache = NoIndexCache + { noIndexCacheEntries :: [NoIndexCacheEntry] + } + +data NoIndexCacheEntry + = CacheGPD GenericPackageDescription !BSS.ByteString + | NoIndexCachePreference [Dependency] + +data SomeRepo r where + SomeLocalRepo :: FilePath -> LocalRepo -> SomeRepo LocalRepo + SomeRemoteRepo :: FilePath -> RemoteRepo -> SomeRepo RemoteRepo + SomeSecureRepo :: FilePath -> RemoteRepo -> SomeRepo SecureRepo + + +-- -- | Check if this is a remote repo isRepoRemote :: Repo -> Bool isRepoRemote RepoLocalNoIndex{} = False