First draft of implementing revisions

lib/GHCup/Download.hs

@@ -289,7 +289,8 @@ getDownloadInfo t v = do
 
   let distro_preview f g =
         let platformVersionSpec =
-              preview (ix t % ix v % viArch % ix a % ix (f p)) dls
+              -- TODO
+              preview (ix t % ix v % viDownload % ix 0 % viArch % ix a % ix (f p)) dls
             mv' = g mv
         in  fmap snd
               .   find

lib/GHCup/GHC.hs

@@ -124,7 +124,8 @@ testGHCVer ver addMakeArgs = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
   dlInfo <-
-    preview (ix GHC % ix ver % viTestDL % _Just) dls
+    -- TODO
+    preview (ix GHC % ix ver % viDownload % ix 0 % viTestDL % _Just) dls
       ?? NoDownload
 
   liftE $ testGHCBindist dlInfo ver addMakeArgs
@@ -257,7 +258,8 @@ fetchGHCSrc :: ( MonadFail m
 fetchGHCSrc v mfp = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   dlInfo <-
-    preview (ix GHC % ix v % viSourceDL % _Just) dls
+    -- TODO
+    preview (ix GHC % ix v % viDownload % ix 0 % viSourceDL % _Just) dls
       ?? NoDownload
   liftE $ downloadCached' dlInfo Nothing mfp
 
@@ -804,7 +806,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patches aargs buildFlavour hadr
 
         -- download source tarball
         dlInfo <-
-          preview (ix GHC % ix (tver ^. tvVersion) % viSourceDL % _Just) dls
+          -- TODO
+          preview (ix GHC % ix (tver ^. tvVersion) % viDownload % ix 0 % viSourceDL % _Just) dls
             ?? NoDownload
         dl <- liftE $ downloadCached dlInfo Nothing
 

lib/GHCup/HLS.hs

@@ -368,7 +368,8 @@ compileHLS targetHLS ghcs jobs ov installDir cabalProject cabalProjectLocal upda
 
       -- download source tarball
       dlInfo <-
-        preview (ix HLS % ix tver % viSourceDL % _Just) dls
+        -- TODO
+        preview (ix HLS % ix tver % viDownload % ix 0 % viSourceDL % _Just) dls
           ?? NoDownload
       dl <- liftE $ downloadCached dlInfo Nothing
 

lib/GHCup/List.hs

@@ -308,7 +308,7 @@ listVersions lt' criteria = do
         isOld  = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
     in if | Map.member currentVer av -> Nothing
           | otherwise -> Just $ ListResult { lVer    = currentVer
-                                           , lTag    = maybe (if isOld then [Old] else []) _viTags listVer
+                                           , lTag    = maybe (if isOld then [Old] else []) (view viTags) listVer
                                            , lCross  = Nothing
                                            , lTool   = GHCup
                                            , fromSrc = False
@@ -337,7 +337,8 @@ listVersions lt' criteria = do
                -> [Either FilePath Version]
                -> (Version, VersionInfo)
                -> m ListResult
-  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
+  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, vi) = do
+    let tags = view viTags vi
     case t of
       GHC -> do
         lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v

lib/GHCup/Types.hs

@@ -44,6 +44,8 @@ import           Graphics.Vty                   ( Key(..) )
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Text                     as T
 import qualified GHC.Generics                  as GHC
+import qualified Data.Map.Strict               as M
+
 
 
 #if !defined(BRICK)
@@ -135,6 +137,19 @@ instance NFData GlobalTool
 -- | All necessary information of a tool version, including
 -- source download and per-architecture downloads.
 data VersionInfo = VersionInfo
+  { _viTags        :: [Tag]              -- ^ version specific tag
+  , _viChangeLog   :: Maybe URI
+  , _viDownload    :: Map Int VersionDownload
+  -- informative messages
+  , _viPostInstall :: Maybe Text
+  , _viPostRemove  :: Maybe Text
+  , _viPreCompile  :: Maybe Text
+  }
+  deriving (Eq, GHC.Generic, Show)
+
+instance NFData VersionInfo
+
+data VersionInfoLegacy = VersionInfoLegacy
   { _viTags        :: [Tag]              -- ^ version specific tag
   , _viChangeLog   :: Maybe URI
   , _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
@@ -147,7 +162,23 @@ data VersionInfo = VersionInfo
   }
   deriving (Eq, GHC.Generic, Show)
 
-instance NFData VersionInfo
+data VersionDownload = VersionDownload
+  { _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
+  , _viTestDL      :: Maybe DownloadInfo -- ^ test tarball
+  , _viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
+
+  }
+  deriving (Eq, GHC.Generic, Show)
+
+instance NFData VersionDownload
+
+fromVersionInfoLegacy :: VersionInfoLegacy -> VersionInfo
+fromVersionInfoLegacy VersionInfoLegacy{..} =
+  VersionInfo {_viDownload = M.singleton 0 $ VersionDownload { _viSourceDL = _viSourceDL
+                                                             , _viTestDL = _viTestDL
+                                                             , _viArch = _viArch
+                                                             }
+              , ..}
 
 
 -- | A tag. These are currently attached to a version of a tool.

lib/GHCup/Types/JSON.hs

@@ -320,11 +320,18 @@ instance FromJSONKey (Maybe VersionRange)  where
       Right x -> pure $ Just x
       Left  e -> fail $ "Failure in (Maybe VersionRange) (FromJSONKey)" <> MP.errorBundlePretty e
 
-
-
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Requirements
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadInfo
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfoLegacy
+deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionDownload
+
+instance FromJSON VersionInfo where
+  parseJSON v = parseLegacy v <|> parseNew v
+   where
+    parseLegacy = fmap fromVersionInfoLegacy . parseJSON @VersionInfoLegacy
+    parseNew = genericParseJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel }
+
+deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VersionInfo
 deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key

lib/GHCup/Types/Optics.hs

@@ -37,6 +37,7 @@ makeLenses ''PlatformResult
 makeLenses ''DownloadInfo
 makeLenses ''Tag
 makeLenses ''VersionInfo
+makeLenses ''VersionDownload
 
 makeLenses ''GHCTargetVersion
 

lib/GHCup/Utils.hs

@@ -781,6 +781,9 @@ getLatestToolFor tool pvpIn dls = do
   let ps = catMaybes $ fmap (\(v, vi) -> (,vi) <$> versionToPVP v) ls
   pure . fmap (first fst) . headMay . filter (\((v, _), _) -> matchPVPrefix pvpIn v) $ ps
 
+-- type ToolVersionSpec = Map Version ToolRevisionSpec
+-- type ToolRevisionSpec = Map Int VersionInfo
+