ghcup 0.2.5.0 → 0.2.6.0

raw patch · 32 files changed

+651/−166 lines, 32 filesdep ~Cabaldep ~Cabal-syntaxdep ~containersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: Cabal, Cabal-syntax, containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• app/ghcup/Main.hs +12/−3
• bench/BenchList.hs +2/−2
• ghcup.cabal +8/−5
• lib-opt/GHCup/OptParse.hs +5/−3
• lib-opt/GHCup/OptParse/Common.hs +8/−2
• lib-opt/GHCup/OptParse/Compile.hs +8/−1
• lib-opt/GHCup/OptParse/List.hs +13/−4
• lib-opt/GHCup/OptParse/Nuke.hs +1/−1
• lib-opt/GHCup/OptParse/Run.hs +10/−11
• lib-opt/GHCup/OptParse/TUI.hs +110/−0
• lib-tui/GHCup/Brick/Actions.hs +21/−18
• lib-tui/GHCup/Brick/App.hs +1/−1
• lib-tui/GHCup/Brick/Common.hs +45/−8
• lib-tui/GHCup/Brick/Widgets/Menus/CompileGHC.hs +6/−0
• lib-tui/GHCup/Brick/Widgets/Navigation.hs +13/−6
• lib-tui/GHCup/BrickMain.hs +16/−4
• lib/GHCup/Command/Compile/GHC.hs +30/−30
• lib/GHCup/Command/GC.hs +1/−1
• lib/GHCup/Command/Install/LowLevel.hs +24/−20
• lib/GHCup/Command/List.hs +20/−8
• lib/GHCup/Input/Parsers.hs +7/−0
• lib/GHCup/Input/Parsers/Domain.hs +158/−0
• lib/GHCup/Input/SymlinkSpec.hs +10/−20
• lib/GHCup/Prelude/MegaParsec.hs +1/−1
• lib/GHCup/Query/DB.hs +1/−0
• lib/GHCup/Types.hs +26/−1
• lib/GHCup/Types/JSON.hs +0/−10
• scripts/bootstrap/bootstrap-haskell +1/−1
• test/ghcup-test/GHCup/ParserSpec.hs +69/−2
• test/optparse-test/CompileTest.hs +1/−0
• test/optparse-test/ListTest.hs +3/−3

@@ -1,5 +1,25 @@ # Version history for ghcup +## 0.2.6.0 -- 2026-06-11++### Bugfixes affecting VSCode++* Fix filtering in `ghcup list` wrt [#1354](https://github.com/haskell/ghcup-hs/issues/1354)+* Fix `ghcup run` with hls [#1357](https://github.com/haskell/ghcup-hs/issues/1357)++### Other bugfixes++* Fix `ghcup compile -o '%v-pre'` wrt [#1361](https://github.com/haskell/ghcup-hs/issues/1361)+* Add missing `--disable-ld-override` to GHC bindist configure runs++### Improvements++* Support installing symlinks via installTheSpec [#1351](https://github.com/haskell/ghcup-hs/issues/1351)+* Add `--docs=TARGET` to 'ghcup compile ghc'+* Implement tui show criteria [#1353](https://github.com/haskell/ghcup-hs/issues/1353)+* Add release channels info to the `--help` by Divam+* Allows bash substitution in domain variables wrt [#1342](https://github.com/haskell/ghcup-hs/issues/1342)+ ## 0.2.5.0 -- 2026-05-26  * Fix broken `ghcup whereis` on non-installed tools wrt [#1347](https://github.com/haskell/ghcup-hs/issues/1347)

@@ -169,10 +169,19 @@         )    let main_footer = [s|Discussion:-  ghcup installs the Glasgow Haskell Compiler from the official+  ghcup installs the Haskell development tools from the configured   release channels, enabling you to easily switch between different   versions. It maintains a self-contained ~/.ghcup directory. +Release Channels:+  * default: maintained by GHCup (recommended)+  * cross: contains experimental cross compilers+  * prereleases: contains pre-releases of all tools+  * vanilla: similar to default but only uses upstream bindists+    (no patches/fixes are applied, no missing platforms added)+  * 3rdparty: access to non-core tools (e.g. hlint, ormolu, agda)+More details at <https://www.haskell.org/ghcup/guide/#release-channels>+ ENV variables:   * GHCUP_INSTALL_BASE_PREFIX: the base of ghcup (default: $HOME)   * GHCUP_USE_XDG_DIRS: set to anything to use XDG style directories@@ -299,9 +308,9 @@            res <- case optCommand of #if defined(BRICK)-            Interactive -> do+            Interactive ioOptions -> do               (appState, _) <- liftIO $ getAppState_and_updateCheckAction-              liftIO $ brickMain appState >> pure ExitSuccess+              liftIO $ brickMain appState ioOptions >> pure ExitSuccess #endif             Install installCommand     -> install installCommand settings (getAppState_and_updateCheckAction, leanAppstate)             Test testCommand           -> test testCommand settings (getAppState_and_updateCheckAction, leanAppstate)

@@ -55,7 +55,7 @@     []          -- list criteria     ShowUpdates -- showRevisions     False       -- hideOld-    True        -- showNightly+    NShowAll    -- showNightly     (Nothing, Nothing)   pure r @@ -66,6 +66,6 @@     []          -- list criteria     ShowUpdates -- showRevisions     False       -- hideOld-    True        -- showNightly+    NShowAll    -- showNightly     (Nothing, Nothing) 

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               ghcup-version:            0.2.5.0+version:            0.2.6.0 license:            LGPL-3.0-only license-file:       LICENSE copyright:          Julian Ospald 2024@@ -142,7 +142,7 @@     , attoparsec             ^>= 0.14     , base                    >=4.12 && <5     , bytestring              >=0.10 && <0.13-    , containers             ^>=0.6 || ^>=0.7+    , containers             ^>=0.6 || ^>=0.7 || ^>=0.8     , deepseq                ^>=1.4 || ^>=1.5 || ^>=1.6     , directory              ^>=1.3.6.0     , filepath                >=1.4.101.0@@ -223,6 +223,7 @@     GHCup.Hardcoded.URLs     GHCup.Hardcoded.Version     GHCup.Input.Parsers+    GHCup.Input.Parsers.Domain     GHCup.Input.Parsers.URI     GHCup.Input.Prompts     GHCup.Input.SymlinkSpec@@ -274,8 +275,8 @@     , base16-bytestring     >=0.1.1.6    && <1.1     , binary                ^>=0.8.6.0 || ^>=0.9 || ^>=0.10     , bz2                   ^>=1.0.1.1-    , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0-    , Cabal-syntax          ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0+    , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0 || ^>= 3.16.0.0+    , Cabal-syntax          ^>=3.6.0.0 || ^>=3.8.0.0 || ^>= 3.10.0.0 || ^>= 3.12.0.0 || ^>= 3.14.0.0 || ^>= 3.16.0.0     , case-insensitive      ^>=1.2.1.0     , casing                ^>=0.1.4.1     , conduit               ^>=1.3@@ -362,6 +363,7 @@     GHCup.OptParse.Rm     GHCup.OptParse.Run     GHCup.OptParse.Set+    GHCup.OptParse.TUI     GHCup.OptParse.Test     GHCup.OptParse.ToolRequirements     GHCup.OptParse.UnSet@@ -402,6 +404,7 @@    build-depends:     , ghcup+    , ghcup-optparse     , brick >=2.1 && <2.13     , vty           ^>=6.0 || ^>=6.1 || ^>=6.2 || ^>=6.3 || ^>=6.4 @@ -465,7 +468,7 @@     , aeson-pretty              ^>=0.8.8     , base                       >=4.12    && <5     , bytestring                 >=0.10    && <0.13-    , containers                ^>=0.6 || ^>=0.7+    , containers                ^>=0.6 || ^>=0.7 || ^>=0.8     , conduit                   ^>=1.3     , directory                 ^>=1.3.6.0     , filepath                   >=1.4.101.0

@@ -9,6 +9,7 @@     module GHCup.OptParse.Common   , module GHCup.OptParse.Install   , module GHCup.OptParse.Test+  , module GHCup.OptParse.TUI   , module GHCup.OptParse.Set   , module GHCup.OptParse.UnSet   , module GHCup.OptParse.Rm@@ -37,6 +38,7 @@ import           GHCup.OptParse.Common import           GHCup.OptParse.Install import           GHCup.OptParse.Test+import           GHCup.OptParse.TUI import           GHCup.OptParse.Set import           GHCup.OptParse.UnSet import           GHCup.OptParse.Rm@@ -120,7 +122,7 @@ #endif   | Nuke #if defined(BRICK)-  | Interactive+  | Interactive InteractiveOptions #endif   | Prefetch PrefetchCommand   | GC GCOptions@@ -203,9 +205,9 @@ #if defined(BRICK)       (  command           "tui"-          (   (\_ -> Interactive)+          (   Interactive           <$> info-                helper+                (interactiveParser <**> helper)                 (  progDesc "Start the interactive GHCup UI"                 )           )

@@ -151,6 +151,12 @@ revisionCompleter :: Completer revisionCompleter = listCompleter ["updates", "all", "none"] +nightlyCompleter :: Completer+nightlyCompleter = listCompleter ["latest", "all", "none"]++docsCompleter :: Completer+docsCompleter = listCompleter ["none", "no-haddocks", "no-sphinx", "no-sphinx-html", "no-sphinx-pdfs", "no-sphinx-man"]+ toolCompleter :: Completer toolCompleter = listCompleter ["ghc", "cabal", "hls", "stack"] @@ -338,7 +344,7 @@            runEnv = flip runReaderT appState . runE -      (VRight installedVersions) <- runEnv $ listVersions (Just [tool]) criteria ShowUpdates False False (Nothing, Nothing)+      (VRight installedVersions) <- runEnv $ listVersions (Just [tool]) criteria ShowUpdates False NShowNone (Nothing, Nothing)       return $ fmap (T.unpack . prettyVer) . filter filter' . maybe [] (fmap lVer . snd) $ M.lookup tool installedVersions  @@ -495,7 +501,7 @@ checkForUpdates = do   dl@GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo   pfreq <- getPlatformReq-  (VRight lInstalled') <- runE $ listVersions Nothing [ListInstalled True] ShowUpdates False False (Nothing, Nothing)+  (VRight lInstalled') <- runE $ listVersions Nothing [ListInstalled True] ShowUpdates False NShowNone (Nothing, Nothing)   let latestInstalled tool = do         (_, xs) <- M.lookup tool lInstalled'         ListResult{..} <- lastMay xs

@@ -86,6 +86,7 @@   , buildSystem :: Maybe BuildSystem   , isolateDir :: Maybe FilePath   , installTargets :: Maybe [String]+  , docs :: Maybe String   }   deriving (Eq, Show) @@ -173,7 +174,7 @@  ghcCompileOpts :: Parser GHCCompileOptions ghcCompileOpts =-  (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir installTargets -> GHCCompileOptions {..})+  (\targetGhc bootstrapGhc hadrianGhc jobs patches crossTarget addConfArgs setCompile overwriteVer buildFlavour (buildSystem, buildConfig) isolateDir installTargets docs -> GHCCompileOptions {..})     <$> ((GHC.SourceDist <$> option           (eitherReader             (first (const "Not a valid version") . version . T.pack)@@ -327,6 +328,11 @@            <> completer (listCompleter ["install", "install_bin", "install_lib", "install_extra", "install_man", "install_docs", "install_data", "update_package_db"])            )            )+    <*> optional (option str+            (  long "docs" <> metavar "none|no-haddocks|no-sphinx|no-sphinx-html|no-sphinx-pdfs|no-sphinx-man" <> help "Disable some or all of the docs"+            <> completer docsCompleter+            )+            )  hlsCompileOpts :: Parser HLSCompileOptions hlsCompileOpts =@@ -642,6 +648,7 @@                     buildSystem                     instDir                     installTargets+                    docs         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo         let vm = getVersionMetadata targetVer ghc dls         case instDir of

@@ -16,7 +16,7 @@ import           GHCup.Errors import           GHCup.Prelude import           GHCup.Types-import           GHCup.Input.Parsers (dayParser, toolParserWithGHCup, criteriaParser, revisionShowParser)+import           GHCup.Input.Parsers (dayParser, toolParserWithGHCup, criteriaParser, revisionShowParser, nightlyShowParser) import           GHCup.OptParse.Common import           GHCup.Prelude.String.QQ import           GHCup.Compat.Terminal@@ -65,7 +65,7 @@   , lFrom          :: Maybe Day   , lTo            :: Maybe Day   , lHideOld       :: Bool-  , lShowNightly   :: Bool+  , lShowNightly   :: ShowNightly   , lRawFormat     :: Bool   , lShowRevisions :: ShowRevisions   } deriving (Eq, Show)@@ -120,9 +120,18 @@     <*> switch           (short 'o' <> long "hide-old" <> help "Hide 'old' tool versions (installed ones are always shown)"           )-    <*> switch-          (short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"+    <*> (option+          (eitherReader nightlyShowParser)+          (long "show-nightlies" <> help "How to show nightlies (default: latest)"+              <> metavar "<latest|all|none>"+              <> completer nightlyCompleter+              <> value NShowLatest           )+          <|> fmap (\_ -> NShowAll) (switch+                (short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"+                )+                )+        )     <*> switch           (short 'r' <> long "raw-format" <> help "More machine-parsable format"           )

@@ -69,7 +69,7 @@        lift $ logInfo "Initiating Nuclear Sequence 🚀🚀🚀"        lift $ logInfo "Nuking in 3...2...1" -       lInstalled' <- liftE $ listVersions Nothing [ListInstalled True] ShowNone False True (Nothing, Nothing)+       lInstalled' <- liftE $ listVersions Nothing [ListInstalled True] ShowNone False NShowAll (Nothing, Nothing)         iforM_ lInstalled' $ \tool (_, ls) -> forM_ ls $ \ListResult{..} -> liftE $ rmToolVersion tool (TargetVersion lCross lVer) 

@@ -514,18 +514,17 @@    setHLS' v tmp = do           Dirs {..}  <- getDirs           legacy <- isLegacyHLS v+          hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? NotInstalled hls (mkTVer v)+          cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)+          liftIO $ print cw+          lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)+          liftIO $ print $ relativeSymlink tmp cw+          hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))+          forM_ hlsBins $ \bin ->+            lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)           if legacy-          then do-            -- TODO: factor this out-            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? NotInstalled hls (mkTVer v)-            cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)-            lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)-            hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))-            forM_ hlsBins $ \bin ->-              lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)-            liftE $ setHLS v SetHLSOnly (Just tmp)-          else do-            liftE $ void $ setToolVersion' hls (mkTVer v) (Just tmp)+          then liftE $ setHLS v SetHLSOnly (Just tmp)+          else liftE $ setHLS v SetHLS_XYZ (Just tmp)     createTmpDir :: ( MonadIOish m )                 => Toolchain

@@ -0,0 +1,110 @@+{-# LANGUAGE CPP               #-}++module GHCup.OptParse.TUI where++import           GHCup.Command.List+import           GHCup.Types+import           GHCup.Input.Parsers (dayParser, toolParserWithGHCup, criteriaParser, revisionShowParser, nightlyShowParser)+import           GHCup.OptParse.Common++import           Data.Functor+import           Data.Maybe+import           Data.Time.Calendar             ( Day )+import           Options.Applicative     hiding ( style )+import           Prelude                 hiding ( appendFile )++++    ---------------+    --[ Options ]--+    ---------------+++data InteractiveOptions = InteractiveOptions+  { ioTool          :: Maybe [Tool]+  , ioCriteria      :: [ListCriteria]+  , ioFrom          :: Maybe Day+  , ioTo            :: Maybe Day+  , ioHideOld       :: Bool+  , ioShowNightly   :: ShowNightly+  , ioShowRevisions :: ShowRevisions+  } deriving (Eq, Show)++++    ---------------+    --[ Parsers ]--+    ---------------++interactiveParser :: Parser InteractiveOptions+interactiveParser =+  InteractiveOptions+    <$> optional+         (some+          (option+            (eitherReader toolParserWithGHCup)+            (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|stack>" <> help+              "Tool to list versions for. Default is all"+              <> completer toolCompleter+            )+          )+        )+    <*> many+          (option+            (eitherReader criteriaParser)+            (  short 'c'+            <> long "show-criteria"+            <> metavar "<installed|set|available>"+            <> help "Apply filtering criteria, prefix with + or -"+              <> completer (listCompleter+                [ "+installed", "+set", "+available", "-installed", "-set", "-available"])+            )+          )+    <*> optional+          (option+            (eitherReader dayParser)+            (short 's' <> long "since" <> metavar "YYYY-MM-DD" <> help+              "List only tools with release date starting at YYYY-MM-DD or later"+              <> completer toolCompleter+            )+          )+    <*> optional+          (option+            (eitherReader dayParser)+            (short 'u' <> long "until" <> metavar "YYYY-MM-DD" <> help+              "List only tools with release date earlier than YYYY-MM-DD"+              <> completer toolCompleter+            )+          )+    <*> switch+          (short 'o' <> long "hide-old" <> help "Hide 'old' tool versions (installed ones are always shown)"+          )+    <*> (option+          (eitherReader nightlyShowParser)+          (long "show-nightlies" <> help "How to show nightlies (default: latest)"+              <> metavar "<latest|all|none>"+              <> completer nightlyCompleter+              <> value NShowLatest+          )+          <|> fmap (\_ -> NShowAll) (switch+                (short 'n' <> long "show-nightly" <> help "Show nightlies (installed ones are always shown)"+                )+                )+        )+    <*> option+          (eitherReader revisionShowParser)+          (long "show-revisions" <> help "How to show revisions (default: updates)"+              <> metavar "<updates|all|none>"+              <> completer revisionCompleter+              <> value ShowUpdates+          )++++++++++

@@ -9,6 +9,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE RecordWildCards #-}  module GHCup.Brick.Actions where @@ -121,7 +122,7 @@               -> Maybe BrickInternalState               -> BrickInternalState constructList appD settings =-  replaceLR (filterVisible (_showAllVersions settings))+  replaceLR (filterVisible (Common._showAllVersions settings))             (_lr appD)  -- | Focus on the tool section and the predicate which matches. If no result matches, focus on index 0@@ -161,16 +162,16 @@         (V.fromList $ fmap (\(tool, (td, filter filterF -> lr)) -> (tool, (td, L.list (Singular tool) (V.fromList lr) 1))) $ M.toList list_result) 1  - filterVisible :: Bool -> ListResult -> Bool-filterVisible v e | lInstalled e = True-                  | v-                  , Nightly `notElem` lTag e = True-                  | not v-                  , Old `notElem` lTag e-                  , Nightly `notElem` lTag e = True-                  | otherwise = (Old `notElem` lTag e)       &&-                                (Nightly `notElem` lTag e)+filterVisible showAll e+  | lInstalled e = True+  | showAll+  = True+  | not showAll+  , Old `notElem` lTag e+  = True+  | otherwise+  = Old `notElem` lTag e  -- | Suspend the current UI and run an IO action in terminal. If the -- IO action returns a Left value, then it's thrown as userError.@@ -188,7 +189,7 @@           flip runReaderT settings $ action (curr_ix', tool, td, lr) >>= \case             Left  err -> liftIO $ putStrLn ("Error: " <> err)             Right _   -> liftIO $ putStrLn "Success"-          getAppData Nothing >>= \case+          getAppData Nothing (view appSettings as) >>= \case             Right data' -> do               putStrLn "Press enter to continue"               _ <- getLine@@ -212,7 +213,7 @@             flip runReaderT settings $ action (curr_ix, tool, td, lr) >>= \case               Left  err -> liftIO $ putStrLn ("Error: " <> err)               Right _   -> liftIO $ putStrLn "Success"-            getAppData Nothing >>= \case+            getAppData Nothing (view appSettings as) >>= \case               Right data' -> do                 putStrLn "Press enter to continue"                 _ <- getLine@@ -550,6 +551,7 @@                     (compopts ^. CompileGHC.buildSystem)                     (maybe GHCupInternal IsolateDir $ compopts ^. CompileGHC.isolateDir)                     (fmap (words . T.unpack) $ compopts ^. CompileGHC.installTargets)+                    (compopts ^. CompileGHC.docs)       AppState { ghcupInfo = GHCupInfo { _ghcupDownloads = dls2 }} <- ask       let vi2 = getVersionMetadata targetVer ghc dls2       when@@ -711,14 +713,15 @@   getAppData :: Maybe GHCupInfo+           -> BrickSettings            -> IO (Either String BrickData)-getAppData mgi = runExceptT $ do+getAppData mgi BrickSettings{..} = runExceptT $ do   r <- ExceptT $ maybe getGHCupInfo (pure . Right) mgi   liftIO $ modifyIORef settings' (\s -> s { ghcupInfo = r })   settings <- liftIO $ readIORef settings'    r' <- lift $ flip runReaderT settings $ runE $ do-    lV <- listVersions Nothing [] ShowUpdates False True (Nothing, Nothing)+    lV <- listVersions bsTool bsCriteria bsShowRevisions bsHideOld bsShowNightly (bsFrom, bsTo)     pure $ BrickData lV   ExceptT $ pure $  either (Left . prettyHFError) Right $ veitherToEither r' @@ -736,8 +739,8 @@        withIOActionRecommended $ installWithOptions (AdvancedInstall.InstallOptions Nothing True Nothing Nothing False [] Nothing))   , ( bShowAllVersions     , Just $ \BrickSettings {..} ->-       if _showAllVersions then "Don't show all versions" else "Show all versions"-    , hideShowHandler' (not . _showAllVersions)+       if not bsHideOld then "Don't show all versions" else "Show all versions"+    , hideShowHandler' (not . Common._showAllVersions)     )   , (bHelp, Just $ const "help", mode .= KeyInfo)   , (KeyCombination Vty.KEnter [], Just $ const "Show tool details", mode .= Common.ToolInfo )@@ -760,8 +763,8 @@   , (bChangelog, Just $ const "ChangeLog", withIOAction changelog')   , ( bShowAllVersions     , Just $ \BrickSettings {..} ->-       if _showAllVersions then "Don't show all versions" else "Show all versions"-    , hideShowHandler' (not . _showAllVersions)+       if not bsHideOld then "Don't show all versions" else "Show all versions"+    , hideShowHandler' (not . Common._showAllVersions)     )   , (bHelp, Just $ const "Help", mode .= KeyInfo)   , (KeyCombination Vty.KEnter [], Just $ const "Advanced options", createMenuforTool )

@@ -103,7 +103,7 @@       $ if st ^. versionFocus          then Actions.keyHandlersVersionList (st ^. appKeys)          else Actions.keyHandlersToolList (st ^. appKeys)-    navg = Navigation.draw (st ^. versionFocus) dimAttrs (st ^. appState) <=> footer+    navg = Navigation.draw (st ^. versionFocus) dimAttrs (st ^. appSettings ) (st ^. appState) <=> footer   in case st ^. mode of        Navigation   -> [navg]        Tutorial     -> [Tutorial.draw (bQuit $ st ^. appKeys), navg]

@@ -34,9 +34,16 @@   frontwardLayer,   enableScreenReader,   zoom,-  defaultAppSettings,   lr,   showAllVersions,+  _showAllVersions,+  bsToolL,+  bsCriteriaL,+  bsFromL,+  bsToL,+  bsHideOldL,+  bsShowNightlyL,+  bsShowRevisionsL,   Name(..),   Mode(..),   BrickData(..),@@ -49,15 +56,17 @@     , CompileGHCButton, CompileHLSButton, CabalProjectEditBox     , CabalProjectLocalEditBox, UpdateCabalCheckBox, GitRefEditBox     , BootstrapGhcSelectBox, HadrianGhcSelectBox, ToolVersionBox, GHCInstallTargets+    , DocsEditBox   ) ) where -import           GHCup.Command.List ( ToolListResult )+import           GHCup.Command.List ( ToolListResult, ListCriteria ) import           GHCup.Prelude ( isWindows )-import           GHCup.Types ( Tool, KeyCombination (KeyCombination) )+import           GHCup.Types ( Tool, KeyCombination (KeyCombination), ShowRevisions, ShowNightly(..) ) import Data.List (intercalate) import           Prelude                 hiding ( appendFile ) import qualified Graphics.Vty                  as Vty-import           Optics.TH (makeLenses)+import           Optics (Lens', lens)+import           Optics.TH (makeLenses, makeLensesFor) import           Optics.Lens (toLensVL) import qualified Brick import qualified Brick.Widgets.Border as Border@@ -65,6 +74,7 @@ import qualified Data.Text as T import qualified Brick.Widgets.Center as Brick import qualified Brick.Widgets.Border.Style as Border+import Data.Time.Calendar (Day)  -- We could use regular ADTs but different menus share the same options. -- example: all of ghcup compile ghc, ghcup compile hls, ghcup install cabal, etc...@@ -139,6 +149,9 @@ pattern GHCInstallTargets :: ResourceId pattern GHCInstallTargets = ResourceId 24 +pattern DocsEditBox :: ResourceId+pattern DocsEditBox = ResourceId 25+ -- | Name data type. Uniquely identifies each widget in the TUI. -- some constructors might end up unused, but still is a good practise -- to have all of them defined, just in case@@ -229,10 +242,34 @@  makeLenses ''BrickData -data BrickSettings = BrickSettings { _showAllVersions :: Bool}+-- Currently the only TUI 'toggable' setting is ioHideOldL... all the+-- other fiels are only used in 'getAppData'. If you want to make+-- them toggable as well, they have to be utilized in 'constructList'.+data BrickSettings = BrickSettings {+    bsTool          :: Maybe [Tool]+  , bsCriteria      :: [ListCriteria]+  , bsFrom          :: Maybe Day+  , bsTo            :: Maybe Day+  , bsHideOld       :: Bool+  , bsShowNightly   :: ShowNightly+  , bsShowRevisions :: ShowRevisions+  }   --deriving Show -makeLenses ''BrickSettings+makeLensesFor+  [ ("bsTool", "bsToolL")+  , ("bsCriteria", "bsCriteriaL")+  , ("bsFrom", "bsFromL")+  , ("bsTo", "bsToL")+  , ("bsHideOld", "bsHideOldL")+  , ("bsShowNightly", "bsShowNightlyL")+  , ("bsShowRevisions", "bsShowRevisionsL")+  ]+  ''BrickSettings -defaultAppSettings :: BrickSettings-defaultAppSettings = BrickSettings False+showAllVersions :: Lens' BrickSettings Bool+showAllVersions = lens (not . bsHideOld) (\BrickSettings{..} showAll -> let bsHideOld = not showAll in BrickSettings{..})++_showAllVersions :: BrickSettings -> Bool+_showAllVersions = not . bsHideOld+

@@ -30,6 +30,7 @@   setCompile,   overwriteVer,   buildFlavour,+  docs,   buildSystem,   isolateDir,   gitRef,@@ -75,6 +76,7 @@   , _setCompile   :: Bool   , _overwriteVer :: Maybe [VersionPattern]   , _buildFlavour :: Maybe String+  , _docs         :: Maybe String   , _buildSystem  :: Maybe BuildSystem   , _isolateDir   :: Maybe FilePath   , _gitRef       :: Maybe String@@ -105,6 +107,7 @@         Nothing         Nothing         initialInstallTargets+        Nothing     validator CompileGHCOptions {..} = case (_setCompile, _isolateDir) of       (True, Just _) -> Just "Cannot set active when doing an isolated install"       _ -> case (_buildConfig, _buildSystem) of@@ -206,6 +209,9 @@       , Menu.createEditableField (Common.MenuElement Common.BuildFlavourEditBox) (Right . Just . T.unpack) buildFlavour           & Menu.fieldLabelL .~ "flavour"           & Menu.fieldHelpMsgL .~ "Set the compile build flavour (this value depends on the build system type: 'make' vs 'hadrian')"+      , Menu.createEditableField (Common.MenuElement Common.DocsEditBox) (Right . Just . T.unpack) docs+          & Menu.fieldLabelL .~ "docs"+          & Menu.fieldHelpMsgL .~ "Disable some or all of the docs (e.g. 'none' or 'no-sphinx')"       , Menu.createEditableField (Common.MenuElement Common.AdditionalEditBox) additionalValidator addConfArgs           & Menu.fieldLabelL .~ "CONFIGURE_ARGS"           & Menu.fieldHelpMsgL .~ "Additional arguments to bindist configure"

@@ -20,7 +20,7 @@       tagToString, ToolDescription,       isCompat,       KeyBindings(..),-      KeyCombination(..))+      KeyCombination(..), ShowRevisions(..)) import qualified GHCup.Brick.Common as Common import qualified GHCup.Brick.Attributes as Attributes import Brick@@ -45,6 +45,7 @@ import Text.PrettyPrint.HughesPJClass (prettyShow) import Control.Monad.State.Class (get, modify) import qualified Graphics.Vty           as Vty+import GHCup.Brick.Common (BrickSettings (..))  type BrickList = L.GenericList Common.Name V.Vector @@ -81,8 +82,8 @@   -- | How to draw the navigation widget-draw :: Bool -> AttrMap -> BrickInternalState -> Widget Common.Name-draw versionFocus dimAttrs bis+draw :: Bool -> AttrMap -> BrickSettings -> BrickInternalState -> Widget Common.Name+draw versionFocus dimAttrs BrickSettings{..} bis   = Brick.padBottom Max       ( Brick.joinBorders $ Brick.withBorderStyle unicode         $ borderWithLabel (Brick.str "GHCup")@@ -127,9 +128,15 @@           | lInstalled -> (Brick.withAttr Attributes.installedAttr $ Brick.str Common.installedSign)           | otherwise  -> (Brick.withAttr Attributes.notInstalledAttr $ Brick.str Common.notInstalledSign)         rev = case lRev of-                (rev', RevUpdate)   -> "-r" <> show rev'-                (rev', RevOutdated) -> "-r" <> show rev'-                (_,    RevNormal)   -> ""+                (rev', RevUpdate)+                  | bsShowRevisions == ShowNone -> ""+                  | otherwise -> "-r" <> show rev'+                (rev', RevOutdated)+                  | bsShowRevisions == ShowNone -> ""+                  | otherwise -> "-r" <> show rev'+                (rev', RevNormal)+                  | bsShowRevisions == ShowAll -> "-r" <> show rev'+                  | otherwise -> ""         ver = case lCross of           Nothing -> T.unpack (prettyVer lVer) <> rev           Just c  -> T.unpack (c <> "-" <> prettyVer lVer) <> rev

@@ -15,6 +15,7 @@  module GHCup.BrickMain where +import GHCup.OptParse.TUI (InteractiveOptions (..)) import GHCup.Command.List ( ListResult (..)) import GHCup.Types     ( Settings(noColor),@@ -42,18 +43,29 @@ import qualified GHCup.Brick.Widgets.Menus.CompileHLS as CompileHLS import Data.Maybe (isNothing) import qualified Data.Map.Strict as M+import GHCup.Brick.Common (BrickSettings(..))    brickMain :: AppState+          -> InteractiveOptions           -> IO ()-brickMain s = do+brickMain s InteractiveOptions{..} = do   writeIORef Actions.settings' s+  let brickSettings = BrickSettings {+          bsTool = ioTool+        , bsCriteria = ioCriteria+        , bsFrom = ioFrom+        , bsTo = ioTo+        , bsHideOld = ioHideOld+        , bsShowNightly = ioShowNightly+        , bsShowRevisions = ioShowRevisions+        } -  eAppData <- Actions.getAppData (Just $ ghcupInfo s)+  eAppData <- Actions.getAppData (Just $ ghcupInfo s) brickSettings   case eAppData of     Right ad -> do-      let initial_list = Actions.constructList ad Common.defaultAppSettings Nothing+      let initial_list = Actions.constructList ad brickSettings Nothing           current_element = L.listSelectedElement initial_list           exit_key =             let KeyBindings {..} = keyBindings s@@ -77,7 +89,7 @@                     pure $ filter (\(ListResult {..}) -> lInstalled && isNothing lCross) lr'                   initstate =                     AppState.BrickState ad-                          Common.defaultAppSettings+                          brickSettings                           initial_list                           (ContextMenu.create (t, (td, lr)) exit_key)                           (AdvancedInstall.create exit_key)

@@ -172,6 +172,7 @@            -> Maybe BuildSystem            -> InstallDir            -> Maybe [String]+           -> Maybe String            -> Excepts                 '[ AlreadyInstalled                  , BuildFailed@@ -201,10 +202,11 @@                  , ParseError                  , NoInstallInfo                  , MalformedInstallInfo+                 , NotFoundInPATH                  ]                 m                 TargetVersion-compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir installTargets+compileGHC targetGhc crossTarget vps bstrap hghc jobs mbuildConfig patches aargs buildFlavour buildSystem installDir installTargets docs   = do     pfreq@PlatformRequest { .. } <- lift getPlatformReq     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo@@ -235,7 +237,7 @@                 Just vps' -> fmap Just $ expandVersionPattern (Just ver) "" "" "" "" vps'                 Nothing   -> pure Nothing -        pure (workdir, tmpUnpack, Just (TargetVersion crossTarget ver), ov)+        pure (workdir, tmpUnpack, TargetVersion crossTarget ver, ov)        RemoteDist uri -> do         lift $ logDebug $ "Requested to compile (from uri): " <> T.pack (show uri)@@ -244,7 +246,7 @@         tmpDownload <- lift withGHCupTmpDir         tmpUnpack <- lift mkGhcupTmpDir         tar <- liftE $ download uri Nothing Nothing Nothing (fromGHCupPath tmpDownload) Nothing False-        (bf, ver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError] tmpUnpack $ do+        (bf, ver) <- liftE $ cleanUpOnError @'[UnknownArchive, ArchiveResult, ProcessError, NotFoundInPATH, ParseError] tmpUnpack $ do           liftE $ unpackToDir (fromGHCupPath tmpUnpack) tar           let regex = [s|^(.*/)*boot$|] :: B.ByteString           [bootFile] <- liftIO $ findFilesDeep@@ -253,24 +255,23 @@                            execBlank                            regex             )-          ver <- liftE $ catchAllE @_ @'[ProcessError, ParseError, NotFoundInPATH] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer-            (appendGHCupPath tmpUnpack (takeDirectory bootFile))+          ver <- liftE $ getGHCVer (appendGHCupPath tmpUnpack (takeDirectory bootFile))           pure (bootFile, ver)          let workdir = appendGHCupPath tmpUnpack (takeDirectory bf)          ov <- case vps of-                Just vps' -> fmap Just $ expandVersionPattern ver "" "" "" "" vps'+                Just vps' -> fmap Just $ expandVersionPattern (Just ver) "" "" "" "" vps'                 Nothing   -> pure Nothing -        let tver = TargetVersion crossTarget <$> ver+        let tver = TargetVersion crossTarget ver         pure (workdir, tmpUnpack, tver, ov)        -- clone from git       GitDist GitBranch{..} -> do         tmpUnpack <- lift mkGhcupTmpDir         let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing-        (ver, ov) <- cleanUpOnError tmpUnpack $ reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] DownloadFailed $ do+        (ver, ov) <- cleanUpOnError tmpUnpack $ reThrowAll @_ @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError, ParseError] DownloadFailed $ do           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo           lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"           lEM $ git [ "init" ]@@ -280,7 +281,7 @@                     , fromString rep ]            -- figure out if we can do a shallow clone-          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError] (\(_ :: ProcessError) -> pure [])+          remoteBranches <- catchE @ProcessError @'[PatchFailed, ProcessError, NotFoundInPATH, DigestError, ContentLengthError, DownloadFailed, GPGError, ParseError] @'[PatchFailed, NotFoundInPATH, DigestError, DownloadFailed, GPGError, ParseError] (\(_ :: ProcessError) -> pure [])               $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)           let shallow_clone                 | isCommitHash ref                     = True@@ -311,18 +312,17 @@           liftE $ applyAnyPatch patches (fromGHCupPath tmpUnpack)            -- bootstrap-          ver <- liftE $ catchAllE @_ @'[ProcessError, ParseError, NotFoundInPATH] @'[] (\_ -> pure Nothing) $ fmap Just $ getGHCVer-            tmpUnpack+          ver <- liftE $ getGHCVer tmpUnpack           liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)           lift $ logInfo $ "Examining git ref " <> T.pack ref <> "\n  " <>-                           "GHC version (from Makefile): " <> T.pack (show (prettyVer <$> ver)) <>+                           "GHC version (from Makefile): " <> prettyVer ver <>                            (if not shallow_clone then "\n  " <> "'git describe' output: " <> fromJust git_describe else mempty) <>                            (if isCommitHash ref then mempty else "\n  " <> "commit hash: " <> chash)           liftIO $ threadDelay 5000000 -- give the user a sec to intervene            ov <- case vps of                   Just vps' -> fmap Just $ expandVersionPattern-                                             ver+                                             (Just ver)                                              (take 7 $ T.unpack chash)                                              (T.unpack chash)                                              (maybe "" T.unpack git_describe)@@ -332,13 +332,12 @@            pure (ver, ov) -        let tver = TargetVersion crossTarget <$> ver+        let tver = TargetVersion crossTarget ver         pure (tmpUnpack, tmpUnpack, tver, ov)     -- the version that's installed may differ from the     -- compiled version, so the user can overwrite it     installVer <- if | Just ov'   <- ov   -> pure (TargetVersion crossTarget ov')-                     | Just tver' <- tver -> pure tver'-                     | otherwise          -> fail "No GHC version given and couldn't detect version. Giving up..."+                     | otherwise          -> pure tver      let rev = fromMaybe 0 $ preview (_GHCupDownloads % ix ghc % toolVersionsL % ix installVer % revisionSpecL % mapLast % _1) dls @@ -362,10 +361,8 @@     mBindist <- liftE $ runBuildAction       tmpUnpack       (do-        -- prefer 'tver', because the real version carries out compatibility checks-        -- we don't want the user to do funny things with it-        let doHadrian = Just <$> compileHadrianBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir-            doMake    = compileMakeBindist (fromMaybe installVer tver) (fromGHCupPath workdir) ghcdir+        let doHadrian = Just <$> compileHadrianBindist tver (fromGHCupPath workdir) ghcdir+            doMake    = compileMakeBindist tver (fromGHCupPath workdir) ghcdir         case buildSystem of           Just Hadrian -> do             lift $ logInfo "Requested to use Hadrian"@@ -400,7 +397,7 @@     let trev = TargetVersionRev installVer rev     case mBindist of       Just bindist -> do-        spec <- liftE $ compileInstallSpec bindist installVer+        spec <- liftE $ compileInstallSpec bindist installVer tver         cSize <- liftIO $ getFileSize bindist         cDigest <- liftIO $ getFileDigest bindist         liftE $ void $ installPackedBindist ghc toolDesc bindist@@ -421,7 +418,7 @@       -- for old Make cross installations we don't get a bindist,       -- so this needs to be done manually       Nothing -> do-        spec <- liftE $ compileInstallSpec' (fromInstallDir ghcdir </> "bin") installVer+        spec <- liftE $ compileInstallSpec' (fromInstallDir ghcdir </> "bin") installVer tver         let dlInfo = (DownloadInfo {                        _dlUri = ""                      , _dlSubdir = Just $ RegexDir "ghc-.*"@@ -454,17 +451,18 @@     , HasPlatformReq env     )     => FilePath                   -- ^ Binary dir-    -> TargetVersion+    -> TargetVersion              -- ^ user requested version+    -> TargetVersion              -- ^ original version     -> Excepts '[ UnknownArchive                 , ArchiveResult                 ] m InstallationSpecResolved-  compileInstallSpec' bindir installVer = do+  compileInstallSpec' bindir installVer origVer = do     pfreq <- lift getPlatformReq-    let pred' f = not (null f) && not (prettyVer (_tvVersion installVer) `T.isSuffixOf` T.pack f)+    let pred' f = not (null f) && not (prettyVer (_tvVersion origVer) `T.isSuffixOf` T.pack f)     files <- liftIO $ listDirectoryFiles bindir     let binaries = filter pred' . fmap takeFileName $ files         -- ghcup whereis picks the first binary, so we need to ensure 'ghc' is at the front-        binariesSorted = nub (maybe id (\(T.unpack -> t) a -> t <> "-" <> a) (_tvTarget installVer) "ghc" <.> exeExt:binaries)+        binariesSorted = nub (maybe id (\(T.unpack -> t) a -> t <> "-" <> a) (_tvTarget origVer) "ghc" <.> exeExt:binaries)     pure $ (defaultGHCInstallSpec pfreq installVer) { _isExeSymLinked = syml binariesSorted }    where     syml binaries =@@ -481,17 +479,18 @@     , HasPlatformReq env     )     => FilePath                   -- ^ archive path-    -> TargetVersion+    -> TargetVersion              -- ^ user requested version+    -> TargetVersion              -- ^ original version     -> Excepts '[ UnknownArchive                 , ArchiveResult                 ] m InstallationSpecResolved-  compileInstallSpec tarball installVer = do+  compileInstallSpec tarball installVer origVer = do     pfreq <- lift getPlatformReq     archiveFiles <- liftE $ getArchiveFiles tarball-    let pred' f = not (null f) && not (prettyVer (_tvVersion installVer) `T.isSuffixOf` T.pack f)+    let pred' f = not (null f) && not (prettyVer (_tvVersion origVer) `T.isSuffixOf` T.pack f)     let binaries = filter pred' . fmap takeFileName . filter ("*/bin/*" ?==) $ archiveFiles         -- ghcup whereis picks the first binary, so we need to ensure 'ghc' is at the front-        binariesSorted = nub (maybe id (\(T.unpack -> t) a -> t <> "-" <> a) (_tvTarget installVer) "ghc" <.> exeExt:binaries)+        binariesSorted = nub (maybe id (\(T.unpack -> t) a -> t <> "-" <> a) (_tvTarget origVer) "ghc" <.> exeExt:binaries)     pure $ (defaultGHCInstallSpec pfreq installVer) { _isExeSymLinked = syml binariesSorted }    where     syml binaries =@@ -570,6 +569,7 @@     liftE $ execWithWrapper hadrian_build                           ( maybe [] (\j  -> ["-j" <> show j]         ) jobs                          ++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour+                         ++ maybe [] (\d -> ["--docs=" <> d]) docs                          ++ ["binary-dist"]                           )                           (Just workdir) "ghc-make"

@@ -86,7 +86,7 @@                 )              => Excepts '[NotInstalled, UninstallFailed, ParseError, MalformedInstallInfo] m () rmUnsetTools = do-  vers <- liftE $ listVersions Nothing [ListInstalled True, ListSet False] ShowUpdates False True (Nothing, Nothing)+  vers <- liftE $ listVersions Nothing [ListInstalled True, ListSet False] ShowUpdates False NShowAll (Nothing, Nothing)   iforM_ vers $ \tool (_, ls) -> forM_ ls $ \ListResult{..} -> liftE $ rmToolVersion tool (TargetVersion lCross lVer)  

@@ -8,6 +8,7 @@ module GHCup.Command.Install.LowLevel where  import GHCup.Errors+import GHCup.Input.Parsers.Domain import GHCup.Input.SymlinkSpec import GHCup.Prelude import GHCup.Prelude.Process@@ -17,6 +18,7 @@ import GHCup.System.Cmd import GHCup.System.Directory import GHCup.Types+import GHCup.Types.JSON (safePath, safeFilename) import GHCup.Types.Optics  import Control.Applicative@@ -30,12 +32,12 @@ import Data.Maybe import Data.Variant.Excepts import Data.Versions                hiding ( patch )-import Data.Void import Prelude                      hiding ( abs ) import System.FilePath import System.FilePattern.Directory  import qualified Data.ByteString       as B+import qualified Data.Map.Strict       as M import qualified Data.Text             as T import qualified System.FilePath.Posix as Posix import qualified Text.Megaparsec       as MP@@ -107,9 +109,9 @@       addConfArgs <- lift $ sanitizefConfOptions extraArgs        let configFile = fromMaybe "configure" _csConfigFile-      processedConfArgs <- forM _csConfigArgs $ \a -> throwOnParseError . parseDomain $ a+      processedConfArgs <- forM _csConfigArgs $ \a -> liftE $ throwOnParseError . parseDomain $ a       newEnv <- forM _csConfigEnv $ \EnvSpec{..} -> do-        processedEnv <- throwOnParseError $ forM _esEnv (\(var, val) -> (var,) <$> parseDomain val)+        processedEnv <- liftE $ throwOnParseError $ forM _esEnv (\(var, val) -> (var,) <$> parseDomain val)         liftIO (augmentEnvironment processedEnv _esUnion)       liftE $ execWithWrapper "sh"                        (("." Posix.</> configFile) : processedConfArgs <> addConfArgs@@ -125,15 +127,15 @@       processedMakeArgs <- case installTargets of         Just it -> do           -- we need to check whether applying 'installTargets' would wipe out PREFIX/DESTDIR-          origArgs <- throwOnParseError $ forM _msMakeArgs parseDomain+          origArgs <- liftE $ throwOnParseError $ forM _msMakeArgs parseDomain           if origArgs /= _msMakeArgs           then throwE $ InvalidBuildConfig $ "Can't overwrite install targets " <> T.pack (show _msMakeArgs) <> " since they contain domain variables."-          else throwOnParseError $ forM it parseDomain+          else liftE $ throwOnParseError $ forM it parseDomain         Nothing ->-          throwOnParseError $ forM _msMakeArgs parseDomain+          liftE $ throwOnParseError $ forM _msMakeArgs parseDomain        newEnv <- forM _msMakeEnv $ \EnvSpec{..} -> do-        processedEnv <- throwOnParseError $ forM _esEnv (\(var, val) -> (var,) <$> parseDomain val)+        processedEnv <- liftE $ throwOnParseError $ forM _esEnv (\(var, val) -> (var,) <$> parseDomain val)         liftIO (augmentEnvironment processedEnv _esUnion)       liftE $ makeWithWrapper processedMakeArgs (Just workdir) "make" newEnv     _ -> pure ()@@ -162,22 +164,14 @@         destDir = fromGHCupPath tmpInstallDest </> dropDrive (fromInstallDir installDest)         into = destDir </> fromMaybe source destFile     liftIO $ createDirRecursive' (takeDirectory into)-    copyFileE from into (not forceInstall)+    handleIO (throwE . CopyError . show) . liftIO . install from into  $ not forceInstall     logDebug $ "cp " <> (if forceInstall then "-f " else "") <> T.pack from <> " " <> T.pack into     pure into -  parseDomain = MP.parse domainParser ""--  throwOnParseError = either (throwE . ParseError . show) pure--  domainParser :: MP.Parsec Void String String-  domainParser = concat <$> many anyOrKnownVars-   where-    -- TODO: make this more efficient-    anyOrKnownVars :: MP.Parsec Void String String-    anyOrKnownVars = MP.try (fmap (const (fromInstallDir installDest)) (MP.chunk "${PREFIX}"))-                 <|> MP.try (fmap (const (fromGHCupPath tmpInstallDest)) (MP.chunk "${TMPDIR}"))-                 <|> fmap (:[]) MP.anySingle+  env = M.fromList [(PREFIX, fromInstallDir installDest)+                   ,(TMPDIR, fromGHCupPath tmpInstallDest)+                   ]+  parseDomain = MP.parse (domainParser env) "installTheSpec"  makeWithWrapper ::   ( MonadIOish m@@ -279,6 +273,7 @@ symlinkBinaries (IsolateDirResolved _) _ _ _ _ = pure () symlinkBinaries (fromInstallDir -> toolDir) rawSpec bindir tool tver = do   let spec = substituteSpec <$> rawSpec+  forM_ spec safeSpec   pvpSyms <- lift $ getPVPSymlinks' (fromInstallDir bindir) spec toolDir   forM_ pvpSyms $ lift . uncurry createLink   case bindir of@@ -286,6 +281,15 @@     GHCupDir d           -> linkMajor (fromGHCupPath d)     GHCupBinDir d        -> whenM (lift isLatest) $ linkMajor d  where+  safeSpec SymlinkSpec{..} = do+    checkSafePath _slTarget+    checkSafeFilename _slLinkName+    forM_ _slSetName checkSafeFilename++  checkSafePath fp = unless (safePath fp) $ throwE (MalformedInstallInfo "'..' or '.' are not allowed")++  checkSafeFilename fp = unless (safeFilename fp) $ throwE (MalformedInstallInfo "'..' or '.' are not allowed and filepath must have no path separators")+   linkMajor d = do     let ver = _tvVersion tver     pvpMajorSyms <- liftE $ getPVPMajorSymlinks' d rawSpec ver toolDir

@@ -125,7 +125,7 @@   -> [ListCriteria]   -> ShowRevisions   -> Bool-  -> Bool+  -> ShowNightly   -> (Maybe Day, Maybe Day)   -> Excepts '[ParseError] m ToolListResult listVersions lt' criteria showRevisions hideOld showNightly days = do@@ -140,8 +140,15 @@                Just VersionRev{..} -> do                  getHLSGHCs _vrVersion                Nothing -> pure []-  pure $ listVersions' dls pfreq instTools hlsGHCs lt' criteria showRevisions hideOld showNightly days+  pure $ listVersions' dls pfreq (filterTools lt' instTools) hlsGHCs lt' criteria showRevisions hideOld showNightly days +filterTools ::+     Maybe [Tool]+  -> Map.Map Tool (Map.Map (Maybe Text) ([VersionRev], Maybe VersionRev))+  -> Map.Map Tool (Map.Map (Maybe Text) ([VersionRev], Maybe VersionRev))+filterTools Nothing    tools = tools+filterTools (Just lt') tools = M.filterWithKey (\k _ -> k `elem` lt') tools+ listVersions' ::      GHCupDownloads   -> PlatformRequest@@ -151,7 +158,7 @@   -> [ListCriteria]   -> ShowRevisions   -> Bool-  -> Bool+  -> ShowNightly   -> (Maybe Day, Maybe Day)   -> ToolListResult listVersions' dls pfreq instTools hlsGHCs lt' criteria showRevisions hideOld showNightly days =@@ -360,9 +367,14 @@     | otherwise = Just lr    filterNightly :: ListResult -> Maybe ListResult-  filterNightly lr@ListResult {..}-    | showNightly = Just lr-    | otherwise   = if lInstalled || (Nightly `notElem` lTag && LatestNightly `notElem` lTag)-                    then Just lr-                    else Nothing+  filterNightly lr@ListResult {..} = case showNightly of+    NShowAll -> Just lr+    NShowLatest -> if | lInstalled -> Just lr+                      | LatestNightly `elem` lTag -> Just lr+                      | Nightly `elem` lTag -> Nothing+                      | otherwise -> Just lr+    NShowNone -> if | lInstalled -> Just lr+                    | LatestNightly `elem` lTag -> Nothing+                    | Nightly `elem` lTag -> Nothing+                    | otherwise -> Just lr 

@@ -271,6 +271,13 @@                       | otherwise               = Left ("Unknown criteria: " <> s')   where t = T.toLower (T.pack s') +nightlyShowParser :: String -> Either String ShowNightly+nightlyShowParser s' | t == T.pack "latest"   = Right NShowLatest+                     | t == T.pack "all"      = Right NShowAll+                     | t == T.pack "none"     = Right NShowNone+                     | otherwise              = Left ("Unknown criteria: " <> s')+  where t = T.toLower (T.pack s')+ criteriaParser :: String -> Either String ListCriteria criteriaParser s' | t == T.pack "installed"   = Right $ ListInstalled True                   | t == T.pack "set"         = Right $ ListSet True

@@ -0,0 +1,158 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{-|+Module      : GHCup.Input.Parsers.Domain+Description : Domain parsers and bashism features for the metadata+Copyright   : (c) Julian Ospald, 2026+License     : LGPL-3.0+Maintainer  : hasufell@hasufell.de+Stability   : experimental+Portability : portable+-}+module GHCup.Input.Parsers.Domain where++import GHCup.Types+import GHCup.Errors++import Data.Bifunctor (bimap)+import Data.Versions                ( Version, version )+import Control.Applicative ( Alternative ((<|>), many) )+import Data.Maybe+import Data.Void+import Text.Regex.Posix+import Data.Variant.Excepts++import qualified Data.Map.Strict as M+import qualified Data.Text       as T+import qualified Text.Megaparsec as MP+++evalDomainVal :: M.Map DomainVariable String -> (DomainVariable, Maybe Substitution) -> Maybe String+evalDomainVal env (dvar, msubst) = do+  var <- M.lookup dvar env+  pure $ maybe var (substitute var) msubst+ where+  mkRegex = makeRegexOpts compBlank execBlank+  stripSuffix (T.pack -> suff) (T.pack -> t) = fmap T.unpack $ T.stripSuffix suff t+  stripPrefix (T.pack -> prev) (T.pack -> t) = fmap T.unpack $ T.stripPrefix prev t+  breakOn (T.pack -> needle) (T.pack -> haystack) = bimap T.unpack T.unpack $ T.breakOn needle haystack+  replace (T.pack -> needle) (T.pack -> replacement) (T.pack -> haystack) = T.unpack $ T.replace needle replacement haystack++  substitute var (Replace needle replacement)+    | null matchedNeedle = var+    | otherwise =+      let (pre, rest) = breakOn matchedNeedle var+      in case stripPrefix matchedNeedle rest of+           Nothing    -> var+           Just rest' -> pre <> replacement <> rest'+   where+    matchedNeedle = match (mkRegex (globToRegex needle)) var+  substitute var (ReplaceAll needle replacement)+    | null matchedNeedle = var+    | otherwise = replace matchedNeedle replacement var+   where+    matchedNeedle = match (mkRegex (globToRegex needle)) var+  substitute var (StripPrefix prefix)+    = let matchedPrefix = match (mkRegex ("^" <> globToRegex prefix)) var+      in fromMaybe var (stripPrefix matchedPrefix var)+  substitute var (StripSuffix suffix)+    = let matchedSuffix = match (mkRegex (globToRegex suffix <> "$")) var+      in fromMaybe var (stripSuffix matchedSuffix var)++-- https://www.man7.org/linux/man-pages/man7/glob.7.html+globToRegex :: String -> String+globToRegex = go+ where+  go :: String -> String+  go ('\\':'*':xs) = '\\' : '*' : go xs+  go ('\\':'?':xs) =        '?' : go xs+  go ('*':xs) = '.'  : '*' : go xs+  go ('?':xs) = '.'                  : go xs+  go ('[':'!':']':xs) = '\\' : '[' : '!' : ']' : go xs+  go ('[':'!':xs) = '[' : '^'        : charClass xs+  go ('[':']':xs) = '[' : '\\' : ']' : charClass xs+  go ('[':xs)     = '['              : charClass xs+  go (x:xs)+    | x `elem` specialChars = '\\' : x : go xs+    | otherwise             =        x : go xs+  go []       = []++  charClass :: String -> String+  charClass ('\\':']':xs) = '\\' : ']' : charClass xs+  charClass (']':xs)      = ']'        : go xs+  charClass (x:xs)+    | x `elem` specialChars = '\\' : x : charClass xs+    | otherwise             =        x : charClass xs+  charClass  [] = []++  -- https://stackoverflow.com/a/400316+  specialChars :: String+  specialChars = ".^$*[\\"++domainParserP :: MP.Parsec Void String (DomainVariable, Maybe Substitution)+domainParserP = (,) <$> (MP.chunk "${" *> var) <*> MP.optional (MP.try subst) <* MP.chunk "}"+ where+  subst = MP.try replaceP <|> MP.try replaceAllP <|> MP.try stripSuffixP <|> MP.try stripPrefixP+  replaceP = Replace <$> (MP.chunk "/" *> MP.some escaped <* MP.chunk "/") <*> MP.many escaped+  replaceAllP = ReplaceAll <$> (MP.chunk "//" *> MP.some escaped <* MP.chunk "/") <*> MP.many escaped+  stripPrefixP = StripPrefix <$> (MP.chunk "#" *> MP.some escaped)+  stripSuffixP = StripSuffix <$> (MP.chunk "%" *> MP.some escaped)+  escaped :: MP.Parsec Void String Char+  escaped = do+    t <- MP.lookAhead MP.anySingle+    if | t == '\\'+       -> MP.chunk "\\" *> MP.anySingle+       | otherwise+       -> MP.noneOf ("/%#}{$" :: String)++  var =   (TARGETFN <$ MP.try (MP.chunk "TARGETFN"))+      <|> (PKGVER   <$ MP.try (MP.chunk "PKGVER"))+      <|> (PREFIX   <$ MP.try (MP.chunk "PREFIX"))+      <|> (TMPDIR   <$ MP.try (MP.chunk "TMPDIR"))++++throwOnParseError :: (Monad m, Show a) => Either a b -> Excepts '[ParseError] m b+throwOnParseError = either (throwE . ParseError . show) pure++domainParser :: M.Map DomainVariable String -> MP.Parsec Void String String+domainParser env = domainParser' env []++domainParser' :: M.Map DomainVariable String -> [DomainVariable] -> MP.Parsec Void String String+domainParser' env skip = concat <$> many anyOrKnownVars+ where+  anyOrKnownVars :: MP.Parsec Void String String+  anyOrKnownVars = do+      (MP.try (Just <$> MP.lookAhead ((,,) <$> MP.anySingle <*> MP.anySingle <*> MP.anySingle)) <|> pure Nothing) >>= \case+        Just ('\\', '$', '{') -> do+          _ <- MP.anySingle+          fmap (:[]) MP.anySingle+        Just ('$', '{', _) -> do+          (matched, r@(dvar, _)) <- MP.match domainParserP+          case evalDomainVal env r of+            Just x -> pure x+            Nothing+              | dvar `elem` skip -> pure matched+              | otherwise -> fail $ "Variable " <> show dvar <> " not found in env"+        _ -> fmap (:[]) MP.anySingle++domainParserVer :: M.Map DomainVariable String -> MP.Parsec Void String [Either Char Version]+domainParserVer env = many anyOrKnownVars+ where+  anyOrKnownVars :: MP.Parsec Void String (Either Char Version)+  anyOrKnownVars = do+      (MP.try (Just <$> MP.lookAhead ((,,) <$> MP.anySingle <*> MP.anySingle <*> MP.anySingle)) <|> pure Nothing) >>= \case+        Just ('\\', '$', '{') -> do+          _ <- MP.anySingle+          fmap Left MP.anySingle+        Just ('$', '{', _) -> do+          r <- domainParserP+          v <- maybe (fail "Variable not found in env") pure (evalDomainVal env r)+          v' <- either (fail . show) pure $ version (T.pack v)+          pure (Right v')+        _ -> fmap Left MP.anySingle

@@ -5,21 +5,21 @@ module GHCup.Input.SymlinkSpec where  import GHCup.Errors+import GHCup.Input.Parsers.Domain+import GHCup.Prelude.Logger import GHCup.Query.GHCupDirs import GHCup.Types import GHCup.Types.Optics-import GHCup.Prelude.Logger -import Control.Applicative          ( Alternative (many), (<|>) ) import Control.Monad                ( forM ) import Control.Monad.IO.Class       ( liftIO ) import Control.Monad.Reader         ( MonadReader ) import Data.Variant.Excepts         ( Excepts, throwE ) import Data.Versions                ( Version, prettyVer )-import Data.Void                    ( Void ) import System.FilePath              ( takeFileName ) import System.FilePattern.Directory ( getDirectoryFilesIgnore ) +import qualified Data.Map.Strict as M import qualified Data.Text       as T import qualified Text.Megaparsec as MP @@ -38,15 +38,10 @@   setName <- forM _slSetName $ either (throwE . ParseError . show) pure . parseDomain   pure $ SymlinkSpec target linkName _slPVPMajorLinks setName  where-   parseDomain = MP.parse domainParser ""+   parseDomain = MP.parse (domainParserVer env) "parseSymlinkSpec"+   env = M.fromList [(PKGVER, T.unpack $ prettyVer ver)+                    ] -   domainParser :: MP.Parsec Void String [Either Char Version]-   domainParser = many anyOrKnownVars-     where-      -- TODO: make this more efficient-      anyOrKnownVars :: MP.Parsec Void String (Either Char Version)-      anyOrKnownVars = MP.try (fmap (const (Right ver)) (MP.chunk "${PKGVER}"))-                   <|> fmap Left MP.anySingle  substituteSpec :: SymlinkSpec [Either Char Version] -> SymlinkFileSpec substituteSpec SymlinkSpec{..} =@@ -79,13 +74,8 @@     logDebug2 $ "Parsed slSetName: " <> T.pack (show _slSetName)     pure SymlinkSpec{..}  where-   parseDomain targetFn = either (throwE . ParseError . show) pure . MP.parse (domainParser targetFn) ""--   domainParser :: FilePath -> MP.Parsec Void String String-   domainParser targetFn = concat <$> many anyOrKnownVars-     where-      -- TODO: make this more efficient-      anyOrKnownVars :: MP.Parsec Void String String-      anyOrKnownVars = MP.try (fmap (const targetFn) (MP.chunk "${TARGETFN}"))-                   <|> fmap (:[]) MP.anySingle+   parseDomain targetFn = throwOnParseError . MP.parse (domainParser' env [PKGVER]) "resolveSymlinkSpec"+    where+     env = M.fromList [(TARGETFN, targetFn)+                      ] 

@@ -14,7 +14,7 @@  import GHCup.Types -import Control.Applicative ( Alternative((<|>), many) )+import Control.Applicative ( Alternative (many, (<|>)) )  #if !MIN_VERSION_base(4,13,0) import Control.Monad.Fail ( MonadFail )

@@ -273,6 +273,7 @@       pure $ TargetVersionRev tv rev  +-- | Might return more tools than requested. getAllInstalledTools ::   ( MonadReader env m   , HasGHCupInfo env

@@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-} #if defined(DHALL) {-# LANGUAGE DeriveAnyClass #-} #endif@@ -32,6 +33,7 @@   where  import {-# SOURCE #-} GHCup.Query.GHCupDirs ( GHCupPath, fromGHCupPath )+import                GHCup.Prelude.Version.QQ (vver) import                GHCup.Types.Stack     ( SetupInfo ) import                GHCup.Types.Tar       ( ArchiveResult (..) ) @@ -513,7 +515,7 @@     _isExeRules = []   , _isDataRules = []   , _isConfigure = Just ConfigSpec {-      _csConfigArgs = ["--prefix=${PREFIX}"]+      _csConfigArgs = ["--prefix=${PREFIX}"] <> ldOverride     , _csConfigEnv  = Nothing     , _csConfigFile = Just "configure"     }@@ -524,7 +526,14 @@   , _isPreserveMtimes = True   , _isExeSymLinked = defaultGHCExeSymLinked pfreq tver (ghcBinaries pfreq tver)   }+ where+  ldOverride+    | _tvVersion tver >= [vver|8.2.2|]+    = ["--disable-ld-override"]+    | otherwise+    = [] + ghcBinaries :: PlatformRequest -> TargetVersion -> [FilePath] ghcBinaries _pfreq _tver = ["ghc", "haddock", "hpc", "hsc2hs", "ghci", "ghc-pkg", "hp2ps", "runhaskell", "runghc"] @@ -1430,3 +1439,19 @@                    | ShowNone   deriving (Eq, Show) +data ShowNightly = NShowLatest+                 | NShowAll+                 | NShowNone+  deriving (Eq, Show)++data Substitution = Replace String String+                  | ReplaceAll String String+                  | StripPrefix String+                  | StripSuffix String+  deriving (Eq, Show)++data DomainVariable = TARGETFN+                    | PKGVER+                    | PREFIX+                    | TMPDIR+  deriving (Eq, Show, Ord)

@@ -424,9 +424,6 @@     _slLinkName <- o .: "linkName"     _slPVPMajorLinks <- fromMaybe False <$> o .:? "pVPMajorLinks"     _slSetName <- o .:? "setName"-    checkSafePath _slTarget-    checkSafeFilename _slLinkName-    forM_ _slSetName checkSafeFilename     pure SymlinkSpec{..}  instance FromJSON SymlinkInputSpec where@@ -437,9 +434,6 @@         _slLinkName <- o .: "linkName"         _slPVPMajorLinks <- o .:? "pVPMajorLinks" .!= False         _slSetName <- o .:? "setName"-        checkSafePath _slTarget-        checkSafeFilename _slLinkName-        forM_ _slSetName checkSafeFilename         pure SymlinkInputSpec{..}       Nothing -> do         _slTargetPattern <- o .: "targetPattern"@@ -447,10 +441,6 @@         _slLinkName <- o .: "linkName"         _slPVPMajorLinks <- o .:? "pVPMajorLinks" .!= False         _slSetName <- o .:? "setName"-        forM_ _slTargetPattern checkSafePath-        forM_ _slTargetPatternIgnore checkSafePath-        checkSafeFilename _slLinkName-        forM_ _slSetName checkSafeFilename         pure SymlinkPatternSpec{..}  instance FromJSON InstallFileRule where

@@ -41,7 +41,7 @@  plat="$(uname -s)" arch=$(uname -m)-ghver="0.2.5.0"+ghver="0.2.6.0" : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"  export GHCUP_SKIP_UPDATE_CHECK=yes

@@ -9,14 +9,17 @@ import GHCup.Types import GHCup.Types.JSON     ()+import GHCup.Input.Parsers.Domain  import           Data.Either        ( isLeft ) import           Data.List.NonEmpty ( NonEmpty (..) )-import qualified Data.Set           as Set import           Data.Versions-import qualified Text.Megaparsec    as MP import           Text.Megaparsec +import qualified Data.Map.Strict as M+import qualified Data.Set           as Set+import qualified Text.Megaparsec    as MP+ import Test.Hspec  spec :: Spec@@ -96,7 +99,71 @@     it "ghcLinkVersion" $ do       MP.parse ghcLinkVersion "" "ghc-8.10.7" `shouldBe` Right ghc8107 +    it "domainParserP" $ do+      MP.parse domainParserP "" "${TARGETFN}"               `shouldBe` Right (TARGETFN, Nothing)+      MP.parse domainParserP "" "${TARGETFN//./}"           `shouldBe` Right (TARGETFN, Just $ ReplaceAll "." "")+      MP.parse domainParserP "" "${TARGETFN/foo/bar}"       `shouldBe` Right (TARGETFN, Just $ Replace "foo" "bar")+      MP.parse domainParserP "" "${TARGETFN/\\/foo/\\/bar}" `shouldBe` Right (TARGETFN, Just $ Replace "/foo" "/bar")+      MP.parse domainParserP "" "${PKGVER#foo}"             `shouldBe` Right (PKGVER,   Just $ StripPrefix "foo")+      MP.parse domainParserP "" "${PKGVER%bar}"             `shouldBe` Right (PKGVER,   Just $ StripSuffix "bar")+      MP.parse domainParserP "" "${PKGVER%\\/bar}"          `shouldBe` Right (PKGVER,   Just $ StripSuffix "/bar")+      MP.parse domainParserP "" "${PKGVER//./\\/..\\/}"     `shouldBe` Right (PKGVER,   Just $ ReplaceAll "." "/../")++    it "domainParser" $ do+      MP.parse (domainParser $ ml (PKGVER, "1.2.3")) "" "haskell-language-server.exe"+        `shouldBe` Right "haskell-language-server.exe"+      MP.parse (domainParser $ ml (PKGVER, "1.2.3")) "" "haskell-language-server-${PKGVER//./}.exe"+        `shouldBe` Right "haskell-language-server-123.exe"+      MP.parse (domainParser $ ml (PKGVER, "1.2.3")) "" "haskell-language-server-${PKGVER/./..}.exe"+        `shouldBe` Right "haskell-language-server-1..2.3.exe"+      MP.parse (domainParser $ ml (PKGVER, "1.2.3")) "" "haskell-language-server-${PKGVER//./\\/..\\/}.exe"+        `shouldBe` Right "haskell-language-server-1/../2/../3.exe"+      MP.parse (domainParser $ ml' [(TARGETFN, "haskell-language-server-9.6.7.exe")+                                   ,(PKGVER, "2.14.0.0")+                                   ]+               ) "" "${TARGETFN%.exe}~${PKGVER}.exe"+        `shouldBe` Right "haskell-language-server-9.6.7~2.14.0.0.exe"+      MP.parse (domainParser $ ml' [(TARGETFN, "haskell-language-server-9.6.7.exe")+                                   ,(PKGVER, "2.14.0.0")+                                   ]+               ) "" "${TARGETFN%.*}~${PKGVER}.exe"+        `shouldBe` Right "haskell-language-server-9~2.14.0.0.exe"++    it "globToRegex" $ do+      globToRegex "foo/bar.ext" `shouldBe` "foo/bar\\.ext"+      globToRegex "[][!]" `shouldBe` "[\\]\\[!]"+      globToRegex "[!][!]" `shouldBe` "\\[!]\\[!]"+      globToRegex "[abk*?]" `shouldBe` "[abk\\*?]"+      globToRegex "foo/bar.ext" `shouldBe` "foo/bar\\.ext"+      globToRegex "f?o/ba*.ext" `shouldBe` "f.o/ba.*\\.ext"++    it "evalDomainVal" $ do+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Nothing)                   `shouldBe` Just "1.2.3"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ Replace "." "")     `shouldBe` Just "12.3"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ ReplaceAll "." "")  `shouldBe` Just "123"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ Replace "." ",")    `shouldBe` Just "1,2.3"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ ReplaceAll "." ",") `shouldBe` Just "1,2,3"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ Replace "l" "k")    `shouldBe` Just "1.2.3"+      evalDomainVal (ml (PKGVER, "1.2.3")) (PKGVER, Just $ ReplaceAll "l" "k") `shouldBe` Just "1.2.3"++      evalDomainVal (ml (TARGETFN, "1.2.3")) (PKGVER, Nothing)                   `shouldBe` Nothing+      evalDomainVal (ml (TARGETFN, "1.2.3")) (PKGVER, Just $ Replace "." "")     `shouldBe` Nothing+      evalDomainVal (ml (TARGETFN, "1.2.3")) (PKGVER, Just $ ReplaceAll "." "")  `shouldBe` Nothing+      evalDomainVal (ml (TARGETFN, "1.2.3")) (PKGVER, Just $ Replace "." ",")    `shouldBe` Nothing+      evalDomainVal (ml (TARGETFN, "1.2.3")) (PKGVER, Just $ ReplaceAll "." ",") `shouldBe` Nothing++      evalDomainVal (ml (TARGETFN, "foo/bar.ext")) (TARGETFN, Nothing)                     `shouldBe` Just "foo/bar.ext"+      evalDomainVal (ml (TARGETFN, "foo/bar.ext")) (TARGETFN, Just $ Replace ".ext" "")    `shouldBe` Just "foo/bar"+      evalDomainVal (ml (TARGETFN, "foo/bar.ext")) (TARGETFN, Just $ ReplaceAll ".ext" "") `shouldBe` Just "foo/bar"+      evalDomainVal (ml (TARGETFN, "foo/bar.ext")) (TARGETFN, Just $ StripSuffix ".ext")   `shouldBe` Just "foo/bar"+      evalDomainVal (ml (TARGETFN, "foo/bar.ext")) (TARGETFN, Just $ StripPrefix "foo/")   `shouldBe` Just "bar.ext"+      evalDomainVal (ml (TARGETFN, "foo/bar.ext*")) (TARGETFN, Just $ Replace ".ext[abk*?]" "") `shouldBe` Just "foo/bar"+      evalDomainVal (ml (TARGETFN, "foo/BaR.ext*")) (TARGETFN, Just $ Replace "[!.][B-D][a-b][A-R][.*?]" "bar") `shouldBe` Just "foobarext*"+      evalDomainVal (ml (TARGETFN, "foo*bar.ext")) (TARGETFN, Just $ StripPrefix "foo\\*")   `shouldBe` Just "bar.ext"+   where+    ml (a, b) = M.singleton a b+    ml' = M.fromList     hls2_13_0_0 = Right TargetVersion {                    _tvTarget = Nothing,                    _tvVersion = Version {

@@ -41,6 +41,7 @@     Nothing     Nothing     Nothing+    Nothing  mkDefaultHLSCompileOptions :: HLSVer -> [ToolVersion] -> HLSCompileOptions mkDefaultHLSCompileOptions target ghcs =

@@ -11,7 +11,7 @@ listTests = buildTestTree listParseWith ("list", listCheckList)  defaultOptions :: ListOptions-defaultOptions = ListOptions Nothing [] Nothing Nothing False False False ShowUpdates+defaultOptions = ListOptions Nothing [] Nothing Nothing False NShowLatest False ShowUpdates  listCheckList :: [(String, ListOptions)] listCheckList =@@ -35,8 +35,8 @@                             defaultOptions{lFrom = Just $ read "2023-07-22", lTo = Just $ read "2023-07-22"})   , ("list -o",             defaultOptions{lHideOld = True})   , ("list --hide-old",     defaultOptions{lHideOld = True})-  , ("list -n",             defaultOptions{lShowNightly = True})-  , ("list --show-nightly", defaultOptions{lShowNightly = True})+  , ("list -n",             defaultOptions{lShowNightly = NShowAll})+  , ("list --show-nightly", defaultOptions{lShowNightly = NShowAll})   , ("list -r",             defaultOptions{lRawFormat = True})   , ("list --raw-format",   defaultOptions{lRawFormat = True})   ]