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