Remove globalTools from metadata
This commit is contained in:
parent
0eba225723
commit
d6601b0353
@ -683,7 +683,7 @@ settings' = unsafePerformIO $ do
|
||||
newIORef $ AppState defaultSettings
|
||||
dirs
|
||||
defaultKeyBindings
|
||||
(GHCupInfo mempty mempty mempty)
|
||||
(GHCupInfo mempty mempty)
|
||||
(PlatformRequest A_64 Darwin Nothing)
|
||||
loggerConfig
|
||||
|
||||
|
@ -261,7 +261,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
|
||||
Just _ -> pure ()
|
||||
|
||||
-- TODO: always run for windows
|
||||
siletRunLogger (flip runReaderT s' $ runE ensureGlobalTools) >>= \case
|
||||
siletRunLogger (flip runReaderT s' $ runE ensureShimGen) >>= \case
|
||||
VRight _ -> pure ()
|
||||
VLeft e -> do
|
||||
runLogger
|
||||
|
@ -170,7 +170,7 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||
(ghcupInfo' :: M.Map GHCTargetVersion DownloadInfo) <-
|
||||
M.mapKeys mkTVer <$> M.traverseMaybeWithKey (\_ a -> pure $ fromStackDownloadInfo a) ghcVersions
|
||||
let ghcupDownloads' = M.singleton GHC (M.map fromDownloadInfo ghcupInfo')
|
||||
pure (GHCupInfo mempty ghcupDownloads' mempty)
|
||||
pure (GHCupInfo mempty ghcupDownloads')
|
||||
where
|
||||
fromDownloadInfo :: DownloadInfo -> VersionInfo
|
||||
fromDownloadInfo dli = let aspec = M.singleton arch (M.singleton plat (M.singleton Nothing dli))
|
||||
@ -189,9 +189,8 @@ getDownloadsF pfreq@(PlatformRequest arch plat _) = do
|
||||
mergeGhcupInfo [] = fail "mergeGhcupInfo: internal error: need at least one GHCupInfo"
|
||||
mergeGhcupInfo xs@(GHCupInfo{}: _) =
|
||||
let newDownloads = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_ghcupDownloads <$> xs)
|
||||
newGlobalTools = M.unionsWith (\_ a2 -> a2 ) (_globalTools <$> xs)
|
||||
newToolReqs = M.unionsWith (M.unionWith (\_ b2 -> b2)) (_toolRequirements <$> xs)
|
||||
in pure $ GHCupInfo newToolReqs newDownloads newGlobalTools
|
||||
in pure $ GHCupInfo newToolReqs newDownloads
|
||||
|
||||
|
||||
|
||||
|
@ -209,7 +209,6 @@ instance HFErrorProject NoCompatiblePlatform where
|
||||
|
||||
-- | Unable to find a download for the requested version/distro.
|
||||
data NoDownload = NoDownload GHCTargetVersion Tool (Maybe PlatformRequest)
|
||||
| NoDownload' GlobalTool
|
||||
deriving Show
|
||||
|
||||
instance Pretty NoDownload where
|
||||
@ -227,7 +226,6 @@ instance Pretty NoDownload where
|
||||
<> T.unpack (prettyVer vv)
|
||||
<> "'"
|
||||
| otherwise = text $ "Unable to find a download for " <> T.unpack (tVerToText tver)
|
||||
pPrint (NoDownload' globalTool) = text $ "Unable to find a download for " <> prettyShow globalTool
|
||||
|
||||
instance HFErrorProject NoDownload where
|
||||
eBase _ = 10
|
||||
|
@ -387,7 +387,7 @@ rmLink fp
|
||||
--
|
||||
-- This overwrites previously existing files.
|
||||
--
|
||||
-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
|
||||
-- On windows, this requires that 'ensureShimGen' was run beforehand.
|
||||
createLink :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
|
@ -74,7 +74,6 @@ data KeyCombination = KeyCombination { key :: Key, mods :: [Modifier] }
|
||||
data GHCupInfo = GHCupInfo
|
||||
{ _toolRequirements :: ToolRequirements
|
||||
, _ghcupDownloads :: GHCupDownloads
|
||||
, _globalTools :: Map GlobalTool DownloadInfo
|
||||
}
|
||||
deriving (Show, GHC.Generic, Eq)
|
||||
|
||||
@ -136,14 +135,6 @@ instance Pretty Tool where
|
||||
|
||||
instance NFData Tool
|
||||
|
||||
data GlobalTool = ShimGen
|
||||
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
|
||||
|
||||
instance NFData GlobalTool
|
||||
|
||||
instance Pretty GlobalTool where
|
||||
pPrint ShimGen = text "shimgen"
|
||||
|
||||
|
||||
-- | All necessary information of a tool version, including
|
||||
-- source download and per-architecture downloads.
|
||||
|
@ -59,7 +59,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''KeepDirs
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Downloader
|
||||
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GPGSetting
|
||||
@ -158,12 +157,6 @@ instance ToJSONKey Tool where
|
||||
instance FromJSONKey Tool where
|
||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
||||
|
||||
instance ToJSONKey GlobalTool where
|
||||
toJSONKey = genericToJSONKey defaultJSONKeyOptions
|
||||
|
||||
instance FromJSONKey GlobalTool where
|
||||
fromJSONKey = genericFromJSONKey defaultJSONKeyOptions
|
||||
|
||||
instance ToJSON TarDir where
|
||||
toJSON (RealDir p) = toJSON p
|
||||
toJSON (RegexDir r) = object ["RegexDir" .= r]
|
||||
@ -288,9 +281,8 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Versio
|
||||
instance FromJSON GHCupInfo where
|
||||
parseJSON = withObject "GHCupInfo" $ \o -> do
|
||||
toolRequirements' <- o .:? "toolRequirements"
|
||||
globalTools' <- o .:? "globalTools"
|
||||
ghcupDownloads' <- o .: "ghcupDownloads"
|
||||
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads' (fromMaybe mempty globalTools'))
|
||||
pure (GHCupInfo (fromMaybe mempty toolRequirements') ghcupDownloads')
|
||||
|
||||
deriveToJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupInfo
|
||||
|
||||
|
@ -1199,24 +1199,22 @@ getVersionInfo v' tool =
|
||||
)
|
||||
|
||||
|
||||
ensureGlobalTools :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasGHCupInfo env
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
|
||||
ensureGlobalTools
|
||||
ensureShimGen :: ( MonadMask m
|
||||
, MonadThrow m
|
||||
, HasLog env
|
||||
, MonadIO m
|
||||
, MonadReader env m
|
||||
, HasDirs env
|
||||
, HasSettings env
|
||||
, HasGHCupInfo env
|
||||
, MonadUnliftIO m
|
||||
, MonadFail m
|
||||
)
|
||||
=> Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
|
||||
ensureShimGen
|
||||
| isWindows = do
|
||||
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
|
||||
dirs <- lift getDirs
|
||||
shimDownload <- liftE $ lE @_ @'[NoDownload]
|
||||
$ maybe (Left (NoDownload' ShimGen)) Right $ Map.lookup ShimGen gTools
|
||||
let shimDownload = DownloadInfo shimGenURL Nothing shimGenSHA Nothing Nothing
|
||||
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
|
||||
void $ (\DigestError{} -> do
|
||||
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
|
||||
|
@ -39,6 +39,12 @@ ghcupURL = [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/
|
||||
stackSetupURL :: URI
|
||||
stackSetupURL = [uri|https://raw.githubusercontent.com/commercialhaskell/stackage-content/master/stack/stack-setup-2.yaml|]
|
||||
|
||||
shimGenURL :: URI
|
||||
shimGenURL = [uri|https://downloads.haskell.org/~ghcup/shimgen/shim-2.exe|]
|
||||
|
||||
shimGenSHA :: T.Text
|
||||
shimGenSHA = T.pack "7c55e201f71860c5babea886007c8fa44b861abf50d1c07e5677eb0bda387a70"
|
||||
|
||||
-- | The current ghcup version.
|
||||
ghcUpVer :: V.PVP
|
||||
ghcUpVer = V.PVP . NE.fromList . fmap fromIntegral $ versionBranch version
|
||||
|
@ -175,10 +175,6 @@ instance Arbitrary Tool where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary GlobalTool where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance Arbitrary GHCupInfo where
|
||||
arbitrary = genericArbitrary
|
||||
shrink = genericShrink
|
||||
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user