Compare commits

..

41 Commits

Author SHA1 Message Date
78c393a16e Fix optparse tests on windows 2023-09-02 18:47:42 +08:00
9c3478075f Merge remote-tracking branch 'origin/pr/864' 2023-09-02 16:35:21 +08:00
7e7c11fda4 Merge remote-tracking branch 'origin/pr/868' 2023-09-02 16:34:30 +08:00
bff14761ac Use optparse-test in release/build 2023-09-02 16:32:46 +08:00
99ddcc938f cabal-fmt 2023-09-02 16:20:54 +08:00
e2301e2fa7 Merge remote-tracking branch 'origin/pr/862' 2023-09-02 16:19:56 +08:00
c52096671e Merge remote-tracking branch 'origin/pr/873' 2023-09-01 13:13:10 +08:00
64f03a2f18 Merge remote-tracking branch 'origin/pr/877' 2023-08-29 18:19:04 +08:00
Fendor
a72b78ef96 Update supported tools table for HLS 2.2.0.0 2023-08-27 14:33:42 +02:00
Zubin Duggal
b17849c258 Add my GPG keys to the docs 2023-08-23 17:59:56 +05:30
d759535faa Merge remote-tracking branch 'origin/pr/870' 2023-08-14 17:45:58 +08:00
Fendor
c25c07aa61 Update supported tool list 2023-08-12 11:56:12 +02:00
Lei Zhu
5f361e1e0b Fix compile test 2023-08-05 13:47:51 +08:00
Lei Zhu
bcb498de20 Merge branch 'master' into optparse-test-suite 2023-08-05 13:08:41 +08:00
Arjun Kathuria
fd6ff9f8ec pretty-print instances for VersionRange and VersionCmp types 2023-07-30 12:45:01 +05:30
Lei Zhu
69d311f0b4 ci 2023-07-29 00:43:33 +08:00
Lei Zhu
fde0e712ac add ci 2023-07-28 23:57:59 +08:00
Lei Zhu
c60aa767ca format 2023-07-28 23:48:03 +08:00
Lei Zhu
78df858ba1 run test 2023-07-28 23:39:21 +08:00
Lei Zhu
f1f4d5e836 gc test 2023-07-28 23:26:19 +08:00
Lei Zhu
2726e83235 whereis test 2023-07-28 23:00:15 +08:00
Lei Zhu
f23631054a compile test 2023-07-28 22:06:16 +08:00
Lei Zhu
9189f9a65a Add absolute description 2023-07-25 23:01:44 +08:00
Lei Zhu
7076472bde compile test 2023-07-25 22:58:01 +08:00
Lei Zhu
6f07b6a343 compile test 2023-07-24 23:04:18 +08:00
Lei Zhu
dfebfc9504 upgrade test 2023-07-24 22:26:33 +08:00
Lei Zhu
36463ebf97 list test 2023-07-24 22:09:03 +08:00
Lei Zhu
f400f43b8c list test 2023-07-23 23:51:03 +08:00
Lei Zhu
c92875882a rm test 2023-07-23 16:30:25 +08:00
Lei Zhu
2df2e3da40 extend unset ghc optparse example 2023-07-23 15:47:47 +08:00
Lei Zhu
cf1e8659b0 unset test 2023-07-23 15:41:27 +08:00
Lei Zhu
fb2e3f2740 test test 2023-07-23 15:19:13 +08:00
Lei Zhu
aafb77df7c install test 2023-07-22 23:10:27 +08:00
Lei Zhu
dc1a813305 config test 2023-07-22 17:46:23 +08:00
Lei Zhu
16c7ecabe2 nuke test 2023-07-22 17:20:42 +08:00
Lei Zhu
e1d8ba869a Add missing stack for changelog parser 2023-07-22 17:16:58 +08:00
Lei Zhu
38db038953 changlog test 2023-07-22 17:14:49 +08:00
Lei Zhu
bcdf2b23f1 debug-info test 2023-07-22 16:07:49 +08:00
Lei Zhu
83b82c328b Set test 2023-07-22 15:31:37 +08:00
Lei Zhu
c10924274d Set test 2023-07-22 11:45:29 +08:00
Lei Zhu
e13c5a99af Remove origin test to ghcup-test subdir 2023-07-20 23:09:14 +08:00
54 changed files with 1387 additions and 121 deletions

11
.editorconfig Normal file
View File

@@ -0,0 +1,11 @@
root = true
[*]
end_of_line = LF
trim_trailing_whitespace = true
insert_final_newline = true
[*.hs]
indent_style = space
indent_size = 2
max_line_length = 80

View File

@@ -27,9 +27,11 @@ build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
mkdir -p out mkdir -p out
binary=$(cabal --project-file=cabal.project.release list-bin ghcup) binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test) binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
binary_opttest=$(cabal --project-file=cabal.project.release list-bin ghcup-optparse-test)
ver=$("${binary}" --numeric-version) ver=$("${binary}" --numeric-version)
strip_binary "${binary}" strip_binary "${binary}"
cp "${binary}" "out/${ARTIFACT}-${ver}${ext}" cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}" cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
cp "${binary_opttest}" "out/test-optparse-${ARTIFACT}-${ver}${ext}"
cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json" cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"

View File

@@ -18,8 +18,10 @@ mkdir -p "${GHCUP_BIN}"
cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}" cp "out/${ARTIFACT}"-* "$GHCUP_BIN/ghcup${ext}"
cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}" cp "out/test-${ARTIFACT}"-* "ghcup-test${ext}"
cp "out/test-optparse-${ARTIFACT}"-* "ghcup-test-optparse${ext}"
chmod +x "$GHCUP_BIN/ghcup${ext}" chmod +x "$GHCUP_BIN/ghcup${ext}"
chmod +x "ghcup-test${ext}" chmod +x "ghcup-test${ext}"
chmod +x "ghcup-test-optparse${ext}"
"$GHCUP_BIN/ghcup${ext}" --version "$GHCUP_BIN/ghcup${ext}" --version
eghcup --version eghcup --version
@@ -29,7 +31,8 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
### Haskell test suite ### Haskell test suite
./ghcup-test${ext} ./ghcup-test${ext}
rm ghcup-test${ext} ./ghcup-test-optparse${ext}
rm ghcup-test${ext} ghcup-test-optparse${ext}
### manual cli based testing ### manual cli based testing

View File

@@ -49,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
{ clOpen :: Bool { clOpen :: Bool
, clTool :: Maybe Tool , clTool :: Maybe Tool
, clToolVer :: Maybe ToolVersion , clToolVer :: Maybe ToolVersion
} } deriving (Eq, Show)
@@ -75,7 +75,7 @@ changelogP =
e -> Left e e -> Left e
) )
) )
(short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup|stack>" <> help
"Open changelog for given tool (default: ghc)" "Open changelog for given tool (default: ghc)"
<> completer toolCompleter <> completer toolCompleter
) )

View File

@@ -83,6 +83,7 @@ data SetToolVersion = SetGHCVersion GHCTargetVersion
| SetToolDay Day | SetToolDay Day
| SetRecommended | SetRecommended
| SetNext | SetNext
deriving (Eq, Show)
prettyToolVer :: ToolVersion -> String prettyToolVer :: ToolVersion -> String
prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v' prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'

View File

@@ -57,6 +57,7 @@ import Text.Read (readEither)
data CompileCommand = CompileGHC GHCCompileOptions data CompileCommand = CompileGHC GHCCompileOptions
| CompileHLS HLSCompileOptions | CompileHLS HLSCompileOptions
deriving (Eq, Show)
@@ -78,7 +79,7 @@ data GHCCompileOptions = GHCCompileOptions
, buildFlavour :: Maybe String , buildFlavour :: Maybe String
, buildSystem :: Maybe BuildSystem , buildSystem :: Maybe BuildSystem
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
} } deriving (Eq, Show)
data HLSCompileOptions = HLSCompileOptions data HLSCompileOptions = HLSCompileOptions
@@ -93,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
, patches :: Maybe (Either FilePath [URI]) , patches :: Maybe (Either FilePath [URI])
, targetGHCs :: [ToolVersion] , targetGHCs :: [ToolVersion]
, cabalArgs :: [Text] , cabalArgs :: [Text]
} } deriving (Eq, Show)
@@ -283,7 +284,7 @@ ghcCompileOpts =
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory") <> completer (bashCompleter "directory")
) )
) )
@@ -366,7 +367,7 @@ hlsCompileOpts =
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made" <> help "install in an isolated absolute directory instead of the default one, no symlinks to this installation will be made"
<> completer (bashCompleter "directory") <> completer (bashCompleter "directory")
) )
) )

View File

@@ -52,6 +52,7 @@ data ConfigCommand
| SetConfig String (Maybe String) | SetConfig String (Maybe String)
| InitConfig | InitConfig
| AddReleaseChannel Bool URI | AddReleaseChannel Bool URI
deriving (Eq, Show)

View File

@@ -47,7 +47,7 @@ data GCOptions = GCOptions
, gcHLSNoGHC :: Bool , gcHLSNoGHC :: Bool
, gcCache :: Bool , gcCache :: Bool
, gcTmp :: Bool , gcTmp :: Bool
} } deriving (Eq, Show)

View File

@@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions
| InstallCabal InstallOptions | InstallCabal InstallOptions
| InstallHLS InstallOptions | InstallHLS InstallOptions
| InstallStack InstallOptions | InstallStack InstallOptions
deriving (Eq, Show)
@@ -70,7 +71,7 @@ data InstallOptions = InstallOptions
, isolateDir :: Maybe FilePath , isolateDir :: Maybe FilePath
, forceInstall :: Bool , forceInstall :: Bool
, addConfArgs :: [T.Text] , addConfArgs :: [T.Text]
} } deriving (Eq, Show)
@@ -196,7 +197,7 @@ installOpts tool =
( short 'i' ( short 'i'
<> long "isolate" <> long "isolate"
<> metavar "DIR" <> metavar "DIR"
<> help "install in an isolated dir instead of the default one" <> help "install in an isolated absolute directory instead of the default one"
<> completer (bashCompleter "directory") <> completer (bashCompleter "directory")
) )
) )

View File

@@ -58,7 +58,7 @@ data ListOptions = ListOptions
, lHideOld :: Bool , lHideOld :: Bool
, lShowNightly :: Bool , lShowNightly :: Bool
, lRawFormat :: Bool , lRawFormat :: Bool
} } deriving (Eq, Show)

View File

@@ -50,6 +50,7 @@ data RmCommand = RmGHC RmOptions
| RmCabal Version | RmCabal Version
| RmHLS Version | RmHLS Version
| RmStack Version | RmStack Version
deriving (Eq, Show)
@@ -61,7 +62,7 @@ data RmCommand = RmGHC RmOptions
data RmOptions = RmOptions data RmOptions = RmOptions
{ ghcVer :: GHCTargetVersion { ghcVer :: GHCTargetVersion
} } deriving (Eq, Show)

View File

@@ -68,7 +68,7 @@ data RunOptions = RunOptions
, runBinDir :: Maybe FilePath , runBinDir :: Maybe FilePath
, runQuick :: Bool , runQuick :: Bool
, runCOMMAND :: [String] , runCOMMAND :: [String]
} } deriving (Eq, Show)

View File

@@ -53,6 +53,7 @@ data SetCommand = SetGHC SetOptions
| SetCabal SetOptions | SetCabal SetOptions
| SetHLS SetOptions | SetHLS SetOptions
| SetStack SetOptions | SetStack SetOptions
deriving (Eq, Show)
@@ -64,7 +65,7 @@ data SetCommand = SetGHC SetOptions
data SetOptions = SetOptions data SetOptions = SetOptions
{ sToolVer :: SetToolVersion { sToolVer :: SetToolVersion
} } deriving (Eq, Show)

View File

@@ -48,6 +48,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
| UnsetCabal UnsetOptions | UnsetCabal UnsetOptions
| UnsetHLS UnsetOptions | UnsetHLS UnsetOptions
| UnsetStack UnsetOptions | UnsetStack UnsetOptions
deriving (Eq, Show)
@@ -59,7 +60,7 @@ data UnsetCommand = UnsetGHC UnsetOptions
data UnsetOptions = UnsetOptions data UnsetOptions = UnsetOptions
{ sToolVer :: Maybe T.Text -- target platform triple { sToolVer :: Maybe T.Text -- target platform triple
} } deriving (Eq, Show)
@@ -68,7 +69,7 @@ data UnsetOptions = UnsetOptions
--[ Parsers ]-- --[ Parsers ]--
--------------- ---------------
unsetParser :: Parser UnsetCommand unsetParser :: Parser UnsetCommand
unsetParser = unsetParser =
subparser subparser
@@ -113,7 +114,14 @@ unsetParser =
unsetGHCFooter :: String unsetGHCFooter :: String
unsetGHCFooter = [s|Discussion: unsetGHCFooter = [s|Discussion:
Unsets the the current GHC version. That means there won't Unsets the the current GHC version. That means there won't
be a ~/.ghcup/bin/ghc anymore.|] be a ~/.ghcup/bin/ghc anymore.
Examples:
# unset ghc
ghcup unset ghc
# unset ghc for the target version
ghcup unset ghc armv7-unknown-linux-gnueabihf|]
unsetCabalFooter :: String unsetCabalFooter :: String
unsetCabalFooter = [s|Discussion: unsetCabalFooter = [s|Discussion:

View File

@@ -50,7 +50,7 @@ import Data.Versions hiding (str)
data UpgradeOpts = UpgradeInplace data UpgradeOpts = UpgradeInplace
| UpgradeAt FilePath | UpgradeAt FilePath
| UpgradeGHCupDir | UpgradeGHCupDir
deriving Show deriving (Eq, Show)

View File

@@ -54,6 +54,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
| WhereisCacheDir | WhereisCacheDir
| WhereisLogsDir | WhereisLogsDir
| WhereisConfDir | WhereisConfDir
deriving (Eq, Show)
@@ -66,7 +67,7 @@ data WhereisCommand = WhereisTool Tool (Maybe ToolVersion)
data WhereisOptions = WhereisOptions { data WhereisOptions = WhereisOptions {
directory :: Bool directory :: Bool
} } deriving (Eq, Show)

View File

@@ -181,15 +181,13 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
-- logger interpreter -- logger interpreter
logfile <- runReaderT initGHCupFileLogging dirs logfile <- runReaderT initGHCupFileLogging dirs
no_color <- isJust <$> lookupEnv "NO_COLOR" no_color <- isJust <$> lookupEnv "NO_COLOR"
liftIO $ hSetBuffering stderr LineBuffering
liftIO $ hSetBuffering logfile LineBuffering
let loggerConfig = LoggerConfig let loggerConfig = LoggerConfig
{ lcPrintDebug = verbose settings { lcPrintDebug = verbose settings
, consoleOutter = T.hPutStr stderr , consoleOutter = T.hPutStr stderr
, fileOutter = , fileOutter =
case optCommand of case optCommand of
Nuke -> \_ -> pure () Nuke -> \_ -> pure ()
_ -> T.hPutStr logfile _ -> T.appendFile logfile
, fancyColors = not no_color , fancyColors = not no_color
} }
let leanAppstate = LeanAppState settings dirs keybindings loggerConfig let leanAppstate = LeanAppState settings dirs keybindings loggerConfig

View File

@@ -23,3 +23,5 @@ package aeson
package streamly package streamly
flags: +use-unliftio flags: +use-unliftio
package *
test-show-details: direct

View File

@@ -491,6 +491,7 @@ First, obtain the gpg keys:
```sh ```sh
gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C gpg --batch --keyserver keys.openpgp.org --recv-keys 7D1E8AFD1D4A16D71FADA2F2CCC85C0E40C06A8C
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01 gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
gpg --batch --keyserver keyserver.ubuntu.com --recv-keys 88B57FCF7DB53B4DB3BFA4B1588764FBE22D19C4
``` ```
Then verify the gpg key in one of these ways: Then verify the gpg key in one of these ways:

View File

@@ -104,14 +104,19 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>GHC Version</th><th>Tags</th></tr></thead> <thead><tr><th>GHC Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>9.6.1</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr> <tr><td>9.6.2</td><td><span style="color:blue">latest</span>, base-4.18.0.0</td></tr>
<tr><td>9.6.1</td><td>base-4.18.0.0</td></tr>
<tr><td>9.4.7</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.6</td><td>base-4.17.2.0</td></tr>
<tr><td>9.4.5</td><td>base-4.17.1.0</td></tr>
<tr><td>9.4.4</td><td>base-4.17.0.0</td></tr> <tr><td>9.4.4</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.3</td><td>base-4.17.0.0</td></tr> <tr><td>9.4.3</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.2</td><td>base-4.17.0.0</td></tr> <tr><td>9.4.2</td><td>base-4.17.0.0</td></tr>
<tr><td>9.4.1</td><td>base-4.17.0.0</td></tr> <tr><td>9.4.1</td><td>base-4.17.0.0</td></tr>
<tr><td>9.2.8</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr>
<tr><td>9.2.7</td><td>base-4.16.4.0</td></tr> <tr><td>9.2.7</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.6</td><td>base-4.16.4.0</td></tr> <tr><td>9.2.6</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.5</td><td><span style="color:green">recommended</span>, base-4.16.4.0</td></tr> <tr><td>9.2.5</td><td>base-4.16.4.0</td></tr>
<tr><td>9.2.4</td><td>base-4.16.3.0</td></tr> <tr><td>9.2.4</td><td>base-4.16.3.0</td></tr>
<tr><td>9.2.3</td><td>base-4.16.2.0</td></tr> <tr><td>9.2.3</td><td>base-4.16.2.0</td></tr>
<tr><td>9.2.2</td><td>base-4.16.1.0</td></tr> <tr><td>9.2.2</td><td>base-4.16.1.0</td></tr>
@@ -166,8 +171,13 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>HLS Version</th><th>Tags</th></tr></thead> <thead><tr><th>HLS Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>1.9.1.0</td><td><span style="color:blue">latest</span></td></tr> <tr><td>2.2.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr>
<tr><td>1.9.0.0</td><td><span style="color:green">recommended</span></td></tr> <tr><td>2.1.0.0</td><td></td></tr>
<tr><td>2.0.0.1</td><td></td></tr>
<tr><td>2.0.0.0</td><td></td></tr>
<tr><td>1.10.0.0</td><td></td></tr>
<tr><td>1.9.1.0</td><td></td></tr>
<tr><td>1.9.0.0</td><td></td></tr>
<tr><td>1.8.0.0</td><td></td></tr> <tr><td>1.8.0.0</td><td></td></tr>
<tr><td>1.7.0.0</td><td></td></tr> <tr><td>1.7.0.0</td><td></td></tr>
<tr><td>1.6.1.0</td><td></td></tr> <tr><td>1.6.1.0</td><td></td></tr>
@@ -186,7 +196,8 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
<table> <table>
<thead><tr><th>Stack Version</th><th>Tags</th></tr></thead> <thead><tr><th>Stack Version</th><th>Tags</th></tr></thead>
<tbody> <tbody>
<tr><td>2.9.3</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></td></tr> <tr><td>2.11.1</td><td><span style="color:blue">latest</span></td></tr>
<tr><td>2.9.3</td><td><span style="color:green">recommended</span></td></tr>
<tr><td>2.9.1</td><td></td></tr> <tr><td>2.9.1</td><td></td></tr>
<tr><td>2.7.5</td><td></td></tr> <tr><td>2.7.5</td><td></td></tr>
<tr><td>2.7.3</td><td></td></tr> <tr><td>2.7.3</td><td></td></tr>
@@ -200,7 +211,7 @@ GHCup supports the following tools, which are also known as the **Haskell Toolch
This list may not be exhaustive and specifies support for bindists only. This list may not be exhaustive and specifies support for bindists only.
| Platform | Architecture | ghcup | GHC | cabal | HLS | stack | | Platform | Architecture | ghcup | GHC | cabal | HLS | stack |
| ------ | ------ | ------ | ------ | ------ | ------ | ------ | | ------ | ------ | ------ | ------ | ------ | ------ | ------ |
| Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ | | Windows 7 | amd64 | ❔ | ✅ | ✅ | ✅ | ✅ |
| Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ | | Windows 10 | amd64 | ✅ | ✅ | ✅ | ✅ | ✅ |

View File

@@ -53,6 +53,43 @@ flag no-exe
default: False default: False
manual: True manual: True
common app-common-depends
build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-install-parsers >=0.4.5
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, haskus-utils-types ^>=1.5
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time >=1.9.3 && <1.12
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
library library
exposed-modules: exposed-modules:
GHCup GHCup
@@ -137,7 +174,7 @@ library
, pretty-terminal ^>=0.1.0.0 , pretty-terminal ^>=0.1.0.0
, regex-posix ^>=0.96 , regex-posix ^>=0.96
, resourcet ^>=1.2.2 , resourcet ^>=1.2.2
, retry ^>=0.8.1.2 || ^>=0.9 , retry >=0.8.1.2 && <0.10
, safe ^>=0.3.18 , safe ^>=0.3.18
, safe-exceptions ^>=0.1 , safe-exceptions ^>=0.1
, split ^>=0.2.3.4 , split ^>=0.2.3.4
@@ -146,7 +183,7 @@ library
, template-haskell >=2.7 && <2.20 , template-haskell >=2.7 && <2.20
, temporary ^>=1.3 , temporary ^>=1.3
, text ^>=2.0 , text ^>=2.0
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11 , time >=1.9.3 && <1.12
, transformers ^>=0.5 , transformers ^>=0.5
, unliftio-core ^>=0.2.0.1 , unliftio-core ^>=0.2.0.1
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
@@ -201,7 +238,67 @@ library
cpp-options: -DBRICK cpp-options: -DBRICK
build-depends: vty ^>=5.37 build-depends: vty ^>=5.37
library ghcup-optparse
import: app-common-depends
exposed-modules:
GHCup.OptParse
GHCup.OptParse.ChangeLog
GHCup.OptParse.Common
GHCup.OptParse.Compile
GHCup.OptParse.Config
GHCup.OptParse.DInfo
GHCup.OptParse.GC
GHCup.OptParse.Install
GHCup.OptParse.List
GHCup.OptParse.Nuke
GHCup.OptParse.Prefetch
GHCup.OptParse.Rm
GHCup.OptParse.Run
GHCup.OptParse.Set
GHCup.OptParse.Test
GHCup.OptParse.ToolRequirements
GHCup.OptParse.UnSet
GHCup.OptParse.Upgrade
GHCup.OptParse.Whereis
hs-source-dirs: app/ghcup
default-language: Haskell2010
default-extensions:
LambdaCase
MultiWayIf
NamedFieldPuns
PackageImports
RecordWildCards
ScopedTypeVariables
StrictData
TupleSections
ghc-options:
-Wall -fwarn-tabs -fwarn-incomplete-uni-patterns
-fwarn-incomplete-record-updates
build-depends: ghcup
if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER
if (flag(tui) && !os(windows))
cpp-options: -DBRICK
other-modules: BrickMain
build-depends:
, brick ^>=1.5
, transformers ^>=0.5
, unix ^>=2.7
, vty ^>=5.37
if os(windows)
cpp-options: -DIS_WINDOWS
else
build-depends: unix ^>=2.7
executable ghcup executable ghcup
import: app-common-depends
main-is: Main.hs main-is: Main.hs
other-modules: other-modules:
GHCup.OptParse GHCup.OptParse
@@ -241,41 +338,8 @@ executable ghcup
-fwarn-incomplete-record-updates -threaded -fwarn-incomplete-record-updates -threaded
build-depends: build-depends:
, aeson >=1.4
, aeson-pretty ^>=0.8.8
, async ^>=2.2.3
, base >=4.12 && <5
, bytestring >=0.10 && <0.12
, cabal-install-parsers >=0.4.5
, cabal-plan ^>=0.7.2
, containers ^>=0.6
, deepseq ^>=1.4
, directory ^>=1.3.6.0
, filepath ^>=1.4.2.1
, ghcup , ghcup
, haskus-utils-types ^>=1.5 , ghcup-optparse
, haskus-utils-variant ^>=3.2.1
, libarchive ^>=3.0.3.0
, megaparsec >=8.0.0 && <9.3
, mtl ^>=2.2
, optparse-applicative >=0.15.1.0 && <0.18
, pretty ^>=1.1.3.1
, pretty-terminal ^>=0.1.0.0
, process ^>=1.6.11.0
, resourcet ^>=1.2.2
, safe ^>=0.3.18
, safe-exceptions ^>=0.1
, tagsoup ^>=0.14
, template-haskell >=2.7 && <2.20
, temporary ^>=1.3
, text ^>=2.0
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, unordered-containers ^>=0.2
, uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0
, vector ^>=0.12
, versions >=4.0.1 && <5.1
, yaml-streamly ^>=0.12.0
if flag(internal-downloader) if flag(internal-downloader)
cpp-options: -DINTERNAL_DOWNLOADER cpp-options: -DINTERNAL_DOWNLOADER
@@ -302,7 +366,7 @@ test-suite ghcup-test
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
main-is: Main.hs main-is: Main.hs
build-tool-depends: hspec-discover:hspec-discover -any build-tool-depends: hspec-discover:hspec-discover -any
hs-source-dirs: test hs-source-dirs: test/ghcup-test
other-modules: other-modules:
GHCup.ArbitraryTypes GHCup.ArbitraryTypes
GHCup.Prelude.File.Posix.TraversalsSpec GHCup.Prelude.File.Posix.TraversalsSpec
@@ -336,8 +400,8 @@ test-suite ghcup-test
, QuickCheck ^>=2.14.1 , QuickCheck ^>=2.14.1
, quickcheck-arbitrary-adt ^>=0.3.1.0 , quickcheck-arbitrary-adt ^>=0.3.1.0
, streamly ^>=0.8.2 , streamly ^>=0.8.2
, time ^>=1.9.3 || ^>=1.10 || ^>=1.11
, text ^>=2.0 , text ^>=2.0
, time >=1.9.3 && <1.12
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, versions >=4.0.1 && <5.1 , versions >=4.0.1 && <5.1
@@ -346,3 +410,39 @@ test-suite ghcup-test
else else
build-depends: unix ^>=2.7 build-depends: unix ^>=2.7
test-suite ghcup-optparse-test
type: exitcode-stdio-1.0
hs-source-dirs: test/optparse-test
main-is: Main.hs
other-modules:
ChangeLogTest
CompileTest
ConfigTest
GCTest
InstallTest
ListTest
OtherCommandTest
RmTest
RunTest
SetTest
UnsetTest
UpgradeTest
Utils
WhereisTest
if os(windows)
cpp-options: -DIS_WINDOWS
default-language: Haskell2010
ghc-options: -Wall
build-depends:
, base
, ghcup
, ghcup-optparse
, optparse-applicative
, tasty
, tasty-hunit
, text
, uri-bytestring
, versions

View File

@@ -5,4 +5,6 @@ cradle:
- component: "ghcup:exe:ghcup" - component: "ghcup:exe:ghcup"
path: ./app/ghcup path: ./app/ghcup
- component: "ghcup:test:ghcup-test" - component: "ghcup:test:ghcup-test"
path: ./test path: ./test/ghcup-test
- component: "ghcup:test:ghcup-optparse-test"
path: ./test/optparse-test

View File

@@ -87,8 +87,6 @@ import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml.Aeson as Y import qualified Data.Yaml.Aeson as Y
import qualified UnliftIO.Async as Async
@@ -113,7 +111,6 @@ getDownloadsF :: ( FromJSONKey Tool
, MonadThrow m , MonadThrow m
, MonadFail m , MonadFail m
, MonadMask m , MonadMask m
, MonadUnliftIO m
) )
=> Excepts => Excepts
'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
@@ -124,12 +121,12 @@ getDownloadsF = do
case urlSource of case urlSource of
GHCupURL -> liftE $ getBase ghcupURL GHCupURL -> liftE $ getBase ghcupURL
(OwnSource exts) -> do (OwnSource exts) -> do
ext <- Async.mapConcurrently (either pure (liftE . getBase)) exts ext <- liftE $ mapM (either pure getBase) exts
mergeGhcupInfo ext mergeGhcupInfo ext
(OwnSpec av) -> pure av (OwnSpec av) -> pure av
(AddSource exts) -> do (AddSource exts) -> do
base <- liftE $ getBase ghcupURL base <- liftE $ getBase ghcupURL
ext <- Async.mapConcurrently (either pure (liftE . getBase)) exts ext <- liftE $ mapM (either pure getBase) exts
mergeGhcupInfo (base:ext) mergeGhcupInfo (base:ext)
where where

View File

@@ -430,8 +430,6 @@ instance HFErrorProject JSONError where
eBase _ = 160 eBase _ = 160
eDesc _ = "JSON decoding failed" eDesc _ = "JSON decoding failed"
instance Exception JSONError
-- | A file that is supposed to exist does not exist -- | A file that is supposed to exist does not exist
-- (e.g. when we use file scheme to "download" something). -- (e.g. when we use file scheme to "download" something).
data FileDoesNotExistError = FileDoesNotExistError FilePath data FileDoesNotExistError = FileDoesNotExistError FilePath
@@ -445,8 +443,6 @@ instance HFErrorProject FileDoesNotExistError where
eBase _ = 170 eBase _ = 170
eDesc _ = "A file that is supposed to exist does not exist (oops)" eDesc _ = "A file that is supposed to exist does not exist (oops)"
instance Exception FileDoesNotExistError
-- | The file already exists -- | The file already exists
-- (e.g. when we use isolated installs with the same path). -- (e.g. when we use isolated installs with the same path).
-- (e.g. This is done to prevent any overwriting) -- (e.g. This is done to prevent any overwriting)
@@ -486,8 +482,6 @@ instance HFErrorProject DigestError where
eBase _ = 200 eBase _ = 200
eDesc _ = "File digest verification failed" eDesc _ = "File digest verification failed"
instance Exception DigestError
-- | File PGP verification failed. -- | File PGP verification failed.
data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs) data GPGError = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => GPGError (V xs)
@@ -500,8 +494,6 @@ instance HFErrorProject GPGError where
eBase _ = 210 eBase _ = 210
eDesc _ = "File PGP verification failed" eDesc _ = "File PGP verification failed"
instance Exception GPGError
-- | Unexpected HTTP status. -- | Unexpected HTTP status.
data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString) data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
deriving Show deriving Show
@@ -715,8 +707,6 @@ instance HFErrorProject DownloadFailed where
eNum (DownloadFailed xs) = 5000 + eNum xs eNum (DownloadFailed xs) = 5000 + eNum xs
eDesc _ = "A download failed." eDesc _ = "A download failed."
instance Exception DownloadFailed
data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorProject (V xs1), Show (V xs2), Pretty (V xs2), HFErrorProject (V xs2)) => InstallSetError (V xs1) (V xs2) data InstallSetError = forall xs1 xs2 . (Show (V xs1), Pretty (V xs1), HFErrorProject (V xs1), Show (V xs2), Pretty (V xs2), HFErrorProject (V xs2)) => InstallSetError (V xs1) (V xs2)
instance Pretty InstallSetError where instance Pretty InstallSetError where

View File

@@ -83,6 +83,7 @@ import qualified Text.Megaparsec as MP
data GHCVer = SourceDist Version data GHCVer = SourceDist Version
| GitDist GitBranch | GitDist GitBranch
| RemoteDist URI | RemoteDist URI
deriving (Eq, Show)

View File

@@ -75,6 +75,7 @@ data HLSVer = SourceDist Version
| GitDist GitBranch | GitDist GitBranch
| HackageDist Version | HackageDist Version
| RemoteDist URI | RemoteDist URI
deriving (Eq, Show)

View File

@@ -65,7 +65,7 @@ import qualified Data.Text as T
data ListCriteria = ListInstalled Bool data ListCriteria = ListInstalled Bool
| ListSet Bool | ListSet Bool
| ListAvailable Bool | ListAvailable Bool
deriving Show deriving (Eq, Show)
-- | A list result describes a single tool version -- | A list result describes a single tool version
-- and various of its properties. -- and various of its properties.

View File

@@ -34,7 +34,6 @@ import Control.Monad.IO.Class
import Control.Monad.Reader import Control.Monad.Reader
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.FilePath import System.FilePath
import System.IO
import System.IO.Error import System.IO.Error
import Text.Regex.Posix import Text.Regex.Posix
@@ -46,7 +45,7 @@ initGHCupFileLogging :: ( MonadReader env m
, HasDirs env , HasDirs env
, MonadIO m , MonadIO m
, MonadMask m , MonadMask m
) => m Handle ) => m FilePath
initGHCupFileLogging = do initGHCupFileLogging = do
Dirs { logsDir } <- getDirs Dirs { logsDir } <- getDirs
let logfile = fromGHCupPath logsDir </> "ghcup.log" let logfile = fromGHCupPath logsDir </> "ghcup.log"
@@ -59,5 +58,4 @@ initGHCupFileLogging = do
forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (fromGHCupPath logsDir </>) forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (fromGHCupPath logsDir </>)
liftIO $ writeFile logfile "" liftIO $ writeFile logfile ""
liftIO $ openFile logfile AppendMode pure logfile

View File

@@ -7,11 +7,7 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}
{-| {-|
Module : GHCup.Types Module : GHCup.Types
@@ -32,15 +28,13 @@ module GHCup.Types
import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath ) import {-# SOURCE #-} GHCup.Utils.Dirs ( fromGHCupPath, GHCupPath )
import Control.Monad
import Control.Monad.Trans.Class ( lift )
import Control.DeepSeq ( NFData, rnf ) import Control.DeepSeq ( NFData, rnf )
import Data.Map.Strict ( Map ) import Data.Map.Strict ( Map )
import Data.List.NonEmpty ( NonEmpty (..) ) import Data.List.NonEmpty ( NonEmpty (..) )
import Data.Time.Calendar ( Day ) import Data.Time.Calendar ( Day )
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Versions import Data.Versions
import GHC.IO.Exception ( ExitCode, IOException(..) ) import GHC.IO.Exception ( ExitCode )
import Optics ( makeLenses ) import Optics ( makeLenses )
import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text) import Text.PrettyPrint.HughesPJClass (Pretty, pPrint, text)
import URI.ByteString import URI.ByteString
@@ -51,13 +45,8 @@ import Graphics.Vty ( Key(..) )
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.Text as T
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Data.List.NonEmpty as NE
import Control.Monad.IO.Unlift import Data.Foldable (foldMap)
import UnliftIO.Exception
import Haskus.Utils.Variant.Excepts
import Haskus.Utils.Variant.VEither
import Control.Monad.Except (ExceptT(..), runExceptT)
#if !defined(BRICK) #if !defined(BRICK)
data Key = KEsc | KChar Char | KBS | KEnter data Key = KEsc | KChar Char | KBS | KEnter
@@ -649,6 +638,17 @@ data VersionRange = SimpleRange (NonEmpty VersionCmp) -- And
instance NFData VersionRange instance NFData VersionRange
instance Pretty VersionCmp where
pPrint (VR_gt v) = text "> " <> pPrint v
pPrint (VR_gteq v) = text ">= " <> pPrint v
pPrint (VR_lt v) = text "< " <> pPrint v
pPrint (VR_lteq v) = text "<= " <> pPrint v
pPrint (VR_eq v) = text "= " <> pPrint v
instance Pretty VersionRange where
pPrint (SimpleRange xs) = foldl1 (\x y -> x <> text " && " <> y) $ NE.map pPrint xs
pPrint (OrRange xs vr) = foldMap pPrint xs <> " || " <> pPrint vr
instance Pretty Versioning where instance Pretty Versioning where
pPrint = text . T.unpack . prettyV pPrint = text . T.unpack . prettyV
@@ -725,6 +725,7 @@ data ToolVersion = GHCVersion GHCTargetVersion
| ToolVersion Version | ToolVersion Version
| ToolTag Tag | ToolTag Tag
| ToolDay Day | ToolDay Day
deriving (Eq, Show)
instance Pretty ToolVersion where instance Pretty ToolVersion where
pPrint (GHCVersion v) = pPrint v pPrint (GHCVersion v) = pPrint v
@@ -737,20 +738,3 @@ instance Pretty ToolVersion where
data BuildSystem = Hadrian data BuildSystem = Hadrian
| Make | Make
deriving (Show, Eq) deriving (Show, Eq)
instance forall es m . (MonadUnliftIO m, Exception (V es)) => MonadUnliftIO (Excepts es m) where
withRunInIO exceptSToIO = Excepts $ fmap (either VLeft VRight) $ try $ do
withRunInIO $ \runInIO ->
exceptSToIO (runInIO . ((\case
VLeft v -> liftIO $ throwIO $ toException v
VRight a -> pure a) <=< runE))
instance Exception (V '[]) where
instance
( Exception x
, Typeable xs
, Exception (V xs)
) => Exception (V (x ': xs))

View File

@@ -24,7 +24,7 @@ spec = do
-- https://github.com/haskell/ghcup-hs/issues/415 -- https://github.com/haskell/ghcup-hs/issues/415
describe "GHCup.Prelude.File.Posix.Traversals" $ do describe "GHCup.Prelude.File.Posix.Traversals" $ do
it "readDirEnt" $ do it "readDirEnt" $ do
dirstream <- liftIO $ openDirStreamPortable "test/data" dirstream <- liftIO $ openDirStreamPortable "test/ghcup-test/data"
(dt1, fp1) <- readDirEntPortable dirstream (dt1, fp1) <- readDirEntPortable dirstream
(dt2, fp2) <- readDirEntPortable dirstream (dt2, fp2) <- readDirEntPortable dirstream
(dt3, fp3) <- readDirEntPortable dirstream (dt3, fp3) <- readDirEntPortable dirstream

View File

@@ -17,6 +17,6 @@ spec = do
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo) roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
where where
goldenDir goldenDir
| isWindows = "test/golden/windows" | isWindows = "test/ghcup-test/golden/windows"
| otherwise = "test/golden/unix" | otherwise = "test/ghcup-test/golden/unix"

View File

@@ -0,0 +1,49 @@
module ChangeLogTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import Test.Tasty.HUnit
import Control.Monad.IO.Class
import GHCup.Types
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
where
check :: String -> ChangeLogOptions -> TestTree
check args expected = testCase args $ do
res <- changeLogParseWith (words args)
liftIO $ res @?= expected
checkList :: [(String, ChangeLogOptions)]
checkList =
[ ("changelog", ChangeLogOptions False Nothing Nothing)
, ("changelog -o", ChangeLogOptions True Nothing Nothing)
, ("changelog -t ghc", ChangeLogOptions False (Just GHC) Nothing)
, ("changelog -t cabal", ChangeLogOptions False (Just Cabal) Nothing)
, ("changelog -t hls", ChangeLogOptions False (Just HLS) Nothing)
, ("changelog -t stack", ChangeLogOptions False (Just Stack) Nothing)
, ("changelog -t ghcup", ChangeLogOptions False (Just GHCup) Nothing)
, ("changelog 9.2", ChangeLogOptions False Nothing
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]))
)
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
, ("changelog -t cabal 3.10.1.0", ChangeLogOptions False (Just Cabal)
(Just $ GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []]))
)
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
]
changeLogParseWith :: [String] -> IO ChangeLogOptions
changeLogParseWith args = do
ChangeLog a <- parseWith args
pure a

View File

@@ -0,0 +1,190 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-}
module CompileTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import Data.Versions
import GHCup.Types
import URI.ByteString.QQ
import qualified GHCup.OptParse.Compile as GHC (GHCCompileOptions(..))
import qualified GHCup.OptParse.Compile as HLS (HLSCompileOptions(..))
import GHCup.GHC as GHC
import GHCup.HLS as HLS
compileTests :: TestTree
compileTests = testGroup "compile"
$ map (buildTestTree compileParseWith)
[ ("ghc", compileGhcCheckList)
, ("hls", compileHlsCheckList)
]
mkDefaultGHCCompileOptions :: GHCVer -> Either Version FilePath -> GHCCompileOptions
mkDefaultGHCCompileOptions target boot =
GHCCompileOptions
target
boot
Nothing
Nothing
(Just $ Right [])
Nothing
[]
False
Nothing
Nothing
Nothing
Nothing
mkDefaultHLSCompileOptions :: HLSVer -> [ToolVersion] -> HLSCompileOptions
mkDefaultHLSCompileOptions target ghcs =
HLSCompileOptions
target
Nothing
True
False
(Left False)
Nothing
Nothing
Nothing
(Just $ Right [])
ghcs
[]
compileGhcCheckList :: [(String, CompileCommand)]
compileGhcCheckList = mapSecond CompileGHC
[ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
, ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" Nothing)
(Left $ mkVersion' "9.2.8")
)
, ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Left $ mkVersion' "9.2.8")
)
, ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Right "/usr/bin/ghc-9.2.2")
)
, ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
(Left $ mkVersion' "9.2.8")
)
, (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
, (baseCmd <> "-c build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
, (baseCmd <> "--config build.mk", baseOptions{GHC.buildConfig = Just "build.mk"})
, (baseCmd <> "--patch file:///example.patch", baseOptions{GHC.patches = Just $ Right [[uri|file:///example.patch|]]})
, (baseCmd <> "-p patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
, (baseCmd <> "--patchdir patch_dir", baseOptions{GHC.patches = Just (Left "patch_dir")})
, (baseCmd <> "-x armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "--cross-target armv7-unknown-linux-gnueabihf", baseOptions{GHC.crossTarget = Just "armv7-unknown-linux-gnueabihf"})
, (baseCmd <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"})
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
, (baseCmd <> "--make", baseOptions{GHC.buildSystem = Just Make})
#ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{GHC.isolateDir = Just "C:\\\\tmp\\out_dir"})
#else
, (baseCmd <> "-i /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{GHC.isolateDir = Just "/tmp/out_dir"})
#endif
]
where
baseCmd :: String
baseCmd = "compile ghc -v 9.4.5 -b 9.2.8 "
baseOptions :: GHCCompileOptions
baseOptions =
mkDefaultGHCCompileOptions
(GHC.SourceDist $ mkVersion' "9.4.5")
(Left $ mkVersion' "9.2.8")
compileHlsCheckList :: [(String, CompileCommand)]
compileHlsCheckList = mapSecond CompileHLS
[ ("compile hls -v 2.0.0.0 --ghc 9.2.8", baseOptions)
, ("compile hls --version 2.0.0.0 --ghc 9.2.8", baseOptions)
, ("compile hls -g a32db0b --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Nothing})
[ghc928]
)
, ("compile hls --git-ref a32db0b --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Nothing})
[ghc928]
)
, ("compile hls -g a32db0b -r https://github.com/haskell/haskell-language-server.git --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Just "https://github.com/haskell/haskell-language-server.git"})
[ghc928]
)
, ("compile hls -g a32db0b --repository https://github.com/haskell/haskell-language-server.git --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.GitDist $ GitBranch {ref = "a32db0b", repo = Just "https://github.com/haskell/haskell-language-server.git"})
[ghc928]
)
, ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.SourceDist $ mkVersion' "2.0.0.0")
[ghc928]
)
, ("compile hls --remote-source-dist https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz --ghc 9.2.8",
mkDefaultHLSCompileOptions
(HLS.RemoteDist [uri|https://github.com/haskell/haskell-language-server/archive/refs/tags/2.0.0.1.tar.gz|])
[ghc928]
)
, ("compile hls -v 2.0.0.0 --ghc latest",
mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0")
[ToolTag Latest]
)
, (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True})
, (baseCmd <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
, (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $ mkVersion' "2.0.0.0-p1"})
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
#ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
, (baseCmd <> "--isolate C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
#else
, (baseCmd <> "-i /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
, (baseCmd <> "--isolate /tmp/out_dir", baseOptions{HLS.isolateDir = Just "/tmp/out_dir"})
#endif
, (baseCmd <> "--cabal-project file:///tmp/cabal.project", baseOptions{HLS.cabalProject = Just $ Right [uri|file:///tmp/cabal.project|]})
, (baseCmd <> "--cabal-project cabal.ghc8107.project", baseOptions{HLS.cabalProject = Just $ Left "cabal.ghc8107.project"})
, (baseCmd <> "--cabal-project-local file:///tmp/cabal.project.local", baseOptions{HLS.cabalProjectLocal = Just [uri|file:///tmp/cabal.project.local|]})
, (baseCmd <> "--patch file:///example.patch", baseOptions{HLS.patches = Just $ Right [[uri|file:///example.patch|]]})
, (baseCmd <> "-p patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
, (baseCmd <> "--patchdir patch_dir", baseOptions{HLS.patches = Just (Left "patch_dir")})
, (baseCmd <> "-- --enable-tests", baseOptions{HLS.cabalArgs = ["--enable-tests"]})
]
where
baseCmd :: String
baseCmd = "compile hls -v 2.0.0.0 --ghc 9.2.8 "
baseOptions :: HLSCompileOptions
baseOptions =
mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0")
[ghc928]
ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8")
compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do
Compile a <- parseWith args
pure a

View File

@@ -0,0 +1,34 @@
{-# LANGUAGE QuasiQuotes #-}
module ConfigTest where
import Test.Tasty
import Test.Tasty.HUnit
import GHCup.OptParse
import Utils
import Control.Monad.IO.Class
import URI.ByteString.QQ
configTests :: TestTree
configTests = testGroup "config" $ map (uncurry check) checkList
where
check :: String -> ConfigCommand -> TestTree
check args expected = testCase args $ do
res <- configParseWith (words args)
liftIO $ res @?= expected
checkList :: [(String, ConfigCommand)]
checkList =
[ ("config", ShowConfig)
, ("config init", InitConfig)
, ("config show", ShowConfig)
, ("config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml"
, AddReleaseChannel False [uri|https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml|]
)
, ("config set cache true", SetConfig "cache" (Just "true"))
]
configParseWith :: [String] -> IO ConfigCommand
configParseWith args = do
Config a <- parseWith args
pure a

View File

@@ -0,0 +1,42 @@
module GCTest where
import Test.Tasty
import GHCup.OptParse
import Utils
gcTests :: TestTree
gcTests = buildTestTree gcParseWith ("gc", gcCheckList)
defaultOptions :: GCOptions
defaultOptions =
GCOptions
False
False
False
False
False
False
gcCheckList :: [(String, GCOptions)]
gcCheckList =
[ ("gc", defaultOptions)
, ("gc -o", defaultOptions{gcOldGHC = True})
, ("gc --ghc-old", defaultOptions{gcOldGHC = True})
, ("gc -p", defaultOptions{gcProfilingLibs = True})
, ("gc --profiling-libs", defaultOptions{gcProfilingLibs = True})
, ("gc -s", defaultOptions{gcShareDir = True})
, ("gc --share-dir", defaultOptions{gcShareDir = True})
, ("gc -h", defaultOptions{gcHLSNoGHC = True})
, ("gc --hls-no-ghc", defaultOptions{gcHLSNoGHC = True})
, ("gc -c", defaultOptions{gcCache = True})
, ("gc --cache", defaultOptions{gcCache = True})
, ("gc -t", defaultOptions{gcTmp = True})
, ("gc --tmpdirs", defaultOptions{gcTmp = True})
, ("gc -o -p -s -h -c -t", GCOptions True True True True True True)
]
gcParseWith :: [String] -> IO GCOptions
gcParseWith args = do
GC a <- parseWith args
pure a

View File

@@ -0,0 +1,223 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module InstallTest where
import Test.Tasty
import GHCup.OptParse hiding (HLSCompileOptions(isolateDir))
import Utils
import GHCup.Types
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import GHCup.OptParse.Install as Install
import URI.ByteString.QQ
-- Some interests:
-- install ghc *won't* select `set as activate version` as default
-- install cabal *will* select `set as activate version` as default
-- install hls *will* select `set as activate version` as default
-- install stack *will* select `set as activate version` as default
installTests :: TestTree
installTests = testGroup "install"
$ map
(buildTestTree installParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", installGhcCheckList)
, ("cabal", installCabalCheckList)
, ("hls", installHlsCheckList)
, ("stack", installStackCheckList)
]
defaultOptions :: InstallOptions
defaultOptions = InstallOptions Nothing Nothing False Nothing False []
-- | Don't set as active version
mkInstallOptions :: ToolVersion -> InstallOptions
mkInstallOptions ver = InstallOptions (Just ver) Nothing False Nothing False []
-- | Set as active version
mkInstallOptions' :: ToolVersion -> InstallOptions
mkInstallOptions' ver = InstallOptions (Just ver) Nothing True Nothing False []
oldStyleCheckList :: [(String, Either InstallCommand InstallOptions)]
oldStyleCheckList =
("install", Right defaultOptions)
: ("install --set", Right defaultOptions{instSet = True})
: ("install --force", Right defaultOptions{forceInstall = True})
#ifdef IS_WINDOWS
: ("install -i C:\\\\", Right defaultOptions{Install.isolateDir = Just "C:\\\\"})
#else
: ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"})
#endif
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|]
, instVer = Just $ GHCVersion $ GHCTargetVersion Nothing (mkVersion $ (Str "head" :| []) :| [])
}
)
: mapSecond
(Right . mkInstallOptions)
[ ("install ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
-- invalid
, ("install next", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "next" :| []) :| [])
)
, ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("install latest-prerelease", ToolTag LatestPrerelease)
, ("install latest-nightly", ToolTag LatestNightly)
, ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal-3.10", GHCVersion
$ GHCTargetVersion
(Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
)
, ("install hls-2.0.0.0", GHCVersion
$ GHCTargetVersion
(Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
)
, ("install stack-2.9.3", GHCVersion
$ GHCTargetVersion
(Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
)
]
installGhcCheckList :: [(String, Either InstallCommand InstallOptions)]
installGhcCheckList =
("install ghc", Left $ InstallGHC defaultOptions)
: mapSecond (Left . InstallGHC . mkInstallOptions)
[ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("install ghc next", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "next" :| []) :| [])
)
, ("install ghc latest", ToolTag Latest)
, ("install ghc nightly", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("install ghc recommended", ToolTag Recommended)
, ("install ghc prerelease", GHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("install ghc latest-prerelease", ToolTag LatestPrerelease)
, ("install ghc latest-nightly", ToolTag LatestNightly)
, ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install ghc ghc-9.2", GHCVersion
$ GHCTargetVersion
(Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
]
installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList =
("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install cabal latest", ToolTag Latest)
, ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install cabal recommended", ToolTag Recommended)
, ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install cabal latest-prerelease", ToolTag LatestPrerelease)
, ("install cabal latest-nightly", ToolTag LatestNightly)
, ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal cabal-3.10", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
installHlsCheckList =
("install hls", Left $ InstallHLS defaultOptions{instSet = True})
: mapSecond (Left . InstallHLS . mkInstallOptions')
[ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install hls latest", ToolTag Latest)
, ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install hls recommended", ToolTag Recommended)
, ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install hls latest-prerelease", ToolTag LatestPrerelease)
, ("install hls latest-nightly", ToolTag LatestNightly)
, ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install hls hls-2.0", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
installStackCheckList =
("install stack", Left $ InstallStack defaultOptions{instSet = True})
: mapSecond (Left . InstallStack . mkInstallOptions')
[ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| [])
, ("install stack latest", ToolTag Latest)
, ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("install stack recommended", ToolTag Recommended)
, ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("install stack latest-prerelease", ToolTag LatestPrerelease)
, ("install stack latest-nightly", ToolTag LatestNightly)
, ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install stack stack-2.9", ToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
]
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)
installParseWith args = do
Install a <- parseWith args
pure a

View File

@@ -0,0 +1,46 @@
module ListTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.List
import GHCup.Types
listTests :: TestTree
listTests = buildTestTree listParseWith ("list", listCheckList)
defaultOptions :: ListOptions
defaultOptions = ListOptions Nothing Nothing Nothing Nothing False False False
listCheckList :: [(String, ListOptions)]
listCheckList =
[ ("list", defaultOptions)
, ("list -t ghc", defaultOptions{loTool = Just GHC})
, ("list -t cabal", defaultOptions{loTool = Just Cabal})
, ("list -t hls", defaultOptions{loTool = Just HLS})
, ("list -t stack", defaultOptions{loTool = Just Stack})
, ("list -c installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c +installed", defaultOptions{lCriteria = Just $ ListInstalled True})
, ("list -c -installed", defaultOptions{lCriteria = Just $ ListInstalled False})
, ("list -c set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c +set", defaultOptions{lCriteria = Just $ ListSet True})
, ("list -c -set", defaultOptions{lCriteria = Just $ ListSet False})
, ("list -c available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c +available", defaultOptions{lCriteria = Just $ ListAvailable True})
, ("list -c -available", defaultOptions{lCriteria = Just $ ListAvailable False})
, ("list -s 2023-07-22", defaultOptions{lFrom = Just $ read "2023-07-22"})
, ("list -u 2023-07-22", defaultOptions{lTo = Just $ read "2023-07-22"})
, ("list --since 2023-07-22 --until 2023-07-22", 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 -r", defaultOptions{lRawFormat = True})
, ("list --raw-format", defaultOptions{lRawFormat = True})
]
listParseWith :: [String] -> IO ListOptions
listParseWith args = do
List a <- parseWith args
pure a

View File

@@ -0,0 +1,33 @@
module Main where
import Test.Tasty
import qualified SetTest
import qualified OtherCommandTest
import qualified ChangeLogTest
import qualified ConfigTest
import qualified InstallTest
import qualified UnsetTest
import qualified RmTest
import qualified ListTest
import qualified UpgradeTest
import qualified CompileTest
import qualified WhereisTest
import qualified GCTest
import qualified RunTest
main :: IO ()
main = defaultMain $ testGroup "ghcup"
[ SetTest.setTests
, OtherCommandTest.otherCommandTests
, ChangeLogTest.changeLogTests
, ConfigTest.configTests
, InstallTest.installTests
, UnsetTest.unsetTests
, RmTest.rmTests
, ListTest.listTests
, UpgradeTest.upgradeTests
, CompileTest.compileTests
, WhereisTest.whereisTests
, GCTest.gcTests
, RunTest.runTests
]

View File

@@ -0,0 +1,38 @@
module OtherCommandTest where
import Test.Tasty
import Test.Tasty.HUnit
import GHCup.OptParse
import Utils
import Control.Monad.IO.Class
otherCommandTests :: TestTree
otherCommandTests = testGroup "other command"
[ testCase "debug-info" $ do
res <- parseWith ["debug-info"]
liftIO $ assertBool "debug-info parse failed" (isDInfo res)
, testCase "tool-requirements" $ do
ToolRequirements opt <- parseWith ["tool-requirements"]
liftIO $ tlrRaw opt @?= False
, testCase "tool-requirements -r" $ do
ToolRequirements opt <- parseWith ["tool-requirements", "--raw-format"]
liftIO $ tlrRaw opt @?= True
, testCase "nuke" $ do
res <- parseWith ["nuke"]
liftIO $ assertBool "nuke parse failed" (isNuke res)
, testCase "test ghc" $ do
res <- parseWith ["test", "ghc"]
liftIO $ assertBool "test parse failed" (isTest res)
]
isDInfo :: Command -> Bool
isDInfo DInfo = True
isDInfo _ = False
isNuke :: Command -> Bool
isNuke Nuke = True
isNuke _ = False
isTest :: Command -> Bool
isTest (Test _) = True
isTest _ = False

View File

@@ -0,0 +1,80 @@
{-# LANGUAGE OverloadedStrings #-}
module RmTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Versions
rmTests :: TestTree
rmTests =
testGroup "rm"
$ map (buildTestTree rmParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", rmGhcCheckList)
, ("cabal", rmCabalCheckList)
, ("hls", rmHlsCheckList)
, ("stack", rmStackCheckList)
]
oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
oldStyleCheckList = mapSecond (Right . RmOptions)
[ -- failed with ("rm", xxx)
("rm 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
]
rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
[ -- failed with ("rm ghc", xxx)
("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []]))
]
rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
rmCabalCheckList = mapSecond (Left . RmCabal)
[ -- failed with ("rm cabal", xxx)
("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("rm cabal cabal-3.10", Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
rmHlsCheckList = mapSecond (Left . RmHLS)
[ -- failed with ("rm hls", xxx)
("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
, ("rm hls hls-2.0", Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
rmStackCheckList :: [(String, Either RmCommand RmOptions)]
rmStackCheckList = mapSecond (Left . RmStack)
[ -- failed with ("rm stack", xxx)
("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []])
, ("rm stack stack-2.9.1", Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
, _vMeta = Nothing
}
)
]
rmParseWith :: [String] -> IO (Either RmCommand RmOptions)
rmParseWith args = do
Rm a <- parseWith args
pure a

View File

@@ -0,0 +1,66 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module RunTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
runTests :: TestTree
runTests = buildTestTree runParseWith ("run", runCheckList)
defaultOptions :: RunOptions
defaultOptions =
RunOptions
False
False
False
Nothing
Nothing
Nothing
Nothing
Nothing
False
[]
runCheckList :: [(String, RunOptions)]
runCheckList =
[ ("run", defaultOptions)
, ("run -a", defaultOptions{runAppendPATH = True})
, ("run --append", defaultOptions{runAppendPATH = True})
, ("run -i", defaultOptions{runInstTool' = True})
, ("run --install", defaultOptions{runInstTool' = True})
, ("run -m", defaultOptions{runMinGWPath = True})
, ("run --mingw-path", defaultOptions{runMinGWPath = True})
, ("run --ghc 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"})
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"})
#ifdef IS_WINDOWS
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
#else
, ("run -b /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
, ("run --bindir /tmp/dir", defaultOptions{runBinDir = Just "/tmp/dir"})
#endif
, ("run -q", defaultOptions{runQuick = True})
, ("run --quick", defaultOptions{runQuick = True})
, ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
defaultOptions
{ runGHCVer = Just $ ToolTag Latest
, runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9"
, runInstTool' = True
}
)
]
runParseWith :: [String] -> IO RunOptions
runParseWith args = do
Run a <- parseWith args
pure a

View File

@@ -0,0 +1,176 @@
{-# LANGUAGE OverloadedStrings #-}
module SetTest where
import GHCup.OptParse
import Test.Tasty
import GHCup.Types
import Data.Versions
import Data.List.NonEmpty (NonEmpty ((:|)))
import Utils
setTests :: TestTree
setTests =
testGroup "set"
$ map
(buildTestTree setParseWith)
[ ("old-style", oldStyleCheckList)
, ("ghc", setGhcCheckList)
, ("cabal", setCabalCheckList)
, ("hls", setHlsCheckList)
, ("stack", setStackCheckList)
]
oldStyleCheckList :: [(String, Either SetCommand SetOptions)]
oldStyleCheckList = mapSecond (Right . SetOptions)
[ ("set", SetRecommended)
, ("set ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("set next", SetNext)
, ("set latest", SetToolTag Latest)
, ("set nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "nightly" :| []) :| [])
)
-- different from `set`
, ("set recommended", SetToolTag Recommended)
, ("set prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("set latest-prerelease", SetToolTag LatestPrerelease)
, ("set latest-nightly", SetToolTag LatestNightly)
, ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal-3.10", SetGHCVersion
$ GHCTargetVersion
(Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
)
, ("set hls-2.0.0.0", SetGHCVersion
$ GHCTargetVersion
(Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []])
)
, ("set stack-2.9.3", SetGHCVersion
$ GHCTargetVersion
(Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []])
)
]
setGhcCheckList :: [(String, Either SetCommand SetOptions)]
setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
[ ("set ghc", SetRecommended)
, ("set ghc 9.2", SetGHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
, ("set ghc next", SetNext)
, ("set ghc latest", SetToolTag Latest)
, ("set ghc nightly", SetGHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "nightly" :| []) :| [])
)
, ("set ghc recommended", SetToolTag Recommended)
, ("set ghc prerelease", SetGHCVersion
$ GHCTargetVersion
Nothing
(mkVersion $ (Str "prerelease" :| []) :| [])
)
, ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
, ("set ghc latest-nightly", SetToolTag LatestNightly)
, ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion
(Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
)
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set ghc ghc-9.2", SetGHCVersion
$ GHCTargetVersion
(Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])
)
]
setCabalCheckList :: [(String, Either SetCommand SetOptions)]
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
[ ("set cabal", SetRecommended)
, ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
, ("set cabal next", SetNext)
, ("set cabal latest", SetToolTag Latest)
, ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set cabal recommended", SetToolTag Recommended)
, ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
, ("set cabal latest-nightly", SetToolTag LatestNightly)
, ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal cabal-3.10", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
]
setHlsCheckList :: [(String, Either SetCommand SetOptions)]
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
[ ("set hls", SetRecommended)
, ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []])
, ("set hls next", SetNext)
, ("set hls latest", SetToolTag Latest)
, ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set hls recommended", SetToolTag Recommended)
, ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set hls latest-prerelease", SetToolTag LatestPrerelease)
, ("set hls latest-nightly", SetToolTag LatestNightly)
, ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set hls hls-2.0", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
]
setStackCheckList :: [(String, Either SetCommand SetOptions)]
setStackCheckList = mapSecond (Left . SetStack . SetOptions)
[ ("set stack", SetRecommended)
, ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []])
, ("set stack next", SetNext)
, ("set stack latest", SetToolTag Latest)
, ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| [])
, ("set stack recommended", SetToolTag Recommended)
, ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| [])
, ("set stack latest-prerelease", SetToolTag LatestPrerelease)
, ("set stack latest-nightly", SetToolTag LatestNightly)
, ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set stack stack-2.9", SetToolVersion
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
]
setParseWith :: [String] -> IO (Either SetCommand SetOptions)
setParseWith args = do
Set a <- parseWith args
pure a

View File

@@ -0,0 +1,50 @@
{-# LANGUAGE OverloadedStrings #-}
module UnsetTest where
import Test.Tasty
import GHCup.OptParse
import Utils
unsetTests :: TestTree
unsetTests =
testGroup "unset"
$ map (buildTestTree unsetParseWith)
[ ("ghc", unsetGhcCheckList)
, ("cabal", unsetCabalCheckList)
, ("hls", unsetHlsCheckList)
, ("stack", unsetStackCheckList)
]
unsetGhcCheckList :: [(String, UnsetCommand)]
unsetGhcCheckList = mapSecond (UnsetGHC . UnsetOptions)
[ ("unset ghc", Nothing)
, ("unset ghc armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetCabalCheckList :: [(String, UnsetCommand)]
unsetCabalCheckList = mapSecond (UnsetCabal . UnsetOptions)
[ ("unset cabal", Nothing)
-- This never used
, ("unset cabal armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetHlsCheckList :: [(String, UnsetCommand)]
unsetHlsCheckList = mapSecond (UnsetHLS . UnsetOptions)
[ ("unset hls", Nothing)
-- This never used
, ("unset hls armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetStackCheckList :: [(String, UnsetCommand)]
unsetStackCheckList = mapSecond (UnsetStack . UnsetOptions)
[ ("unset stack", Nothing)
-- This never used
, ("unset stack armv7-unknown-linux-gnueabihf", Just "armv7-unknown-linux-gnueabihf")
]
unsetParseWith :: [String] -> IO UnsetCommand
unsetParseWith args = do
UnSet a <- parseWith args
pure a

View File

@@ -0,0 +1,38 @@
{-# LANGUAGE TupleSections #-}
module UpgradeTest where
import Test.Tasty
import GHCup.OptParse
import Utils
upgradeTests :: TestTree
upgradeTests = buildTestTree upgradeParseWith ("upgrade", upgradeCheckList)
type FullUpgradeOpts =
( UpgradeOpts
, Bool -- ^Force update
, Bool -- ^Fails after upgrading if the upgraded ghcup binary is shadowed by something else in PATH (useful for CI)
)
mkDefaultOptions :: UpgradeOpts -> FullUpgradeOpts
mkDefaultOptions = (, False, False)
upgradeCheckList :: [(String, FullUpgradeOpts)]
upgradeCheckList =
[ ("upgrade", mkDefaultOptions UpgradeGHCupDir)
, ("upgrade -f", (UpgradeGHCupDir, True, False))
, ("upgrade --force", (UpgradeGHCupDir, True, False))
, ("upgrade --fail-if-shadowed", (UpgradeGHCupDir, False, True))
, ("upgrade -i", mkDefaultOptions UpgradeInplace)
, ("upgrade --inplace", mkDefaultOptions UpgradeInplace)
, ("upgrade -t ~", mkDefaultOptions $ UpgradeAt "~")
, ("upgrade --target ~", mkDefaultOptions $ UpgradeAt "~")
, ("upgrade -t ~ -f", (UpgradeAt "~", True, False))
]
upgradeParseWith :: [String] -> IO FullUpgradeOpts
upgradeParseWith args = do
Upgrade a b c <- parseWith args
pure (a, b, c)

View File

@@ -0,0 +1,45 @@
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Utils where
import GHCup.OptParse as GHCup
import Options.Applicative
import Data.Bifunctor
import Data.Versions
import Data.List.NonEmpty (NonEmpty)
import Test.Tasty
import Test.Tasty.HUnit
import Control.Monad.IO.Class
import qualified Data.Text as T
parseWith :: [String] -> IO Command
parseWith args =
optCommand <$> handleParseResult
(execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
padLeft :: Int -> String -> String
padLeft desiredLength s = padding ++ s
where padding = replicate (desiredLength - length s) ' '
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond = map . second
mkVersion :: NonEmpty VChunk -> Version
mkVersion chunks = Version Nothing chunks [] Nothing
mkVersion' :: T.Text -> Version
mkVersion' txt =
let Right ver = version txt
in ver
buildTestTree
:: (Eq a, Show a)
=> ([String] -> IO a) -- ^ The parse function
-> (String, [(String, a)]) -- ^ The check list @(test group, [(cli command, expected value)])@
-> TestTree
buildTestTree parse (title, checkList) =
testGroup title
$ zipWith (uncurry . check) [1 :: Int ..] checkList
where
check idx args expected = testCase (padLeft 2 (show idx) ++ "." ++ args) $ do
res <- parse (words args)
liftIO $ res @?= expected

View File

@@ -0,0 +1,40 @@
{-# LANGUAGE OverloadedStrings #-}
module WhereisTest where
import Test.Tasty
import GHCup.OptParse
import Utils
import GHCup.Types
whereisTests :: TestTree
whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
whereisCheckList = concatMap mk
[ ("whereis ghc", WhereisTool GHC Nothing)
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8"))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "9.2.8")))
, ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
, ("whereis cabal", WhereisTool Cabal Nothing)
, ("whereis hls", WhereisTool HLS Nothing)
, ("whereis stack", WhereisTool Stack Nothing)
, ("whereis ghcup", WhereisTool GHCup Nothing)
, ("whereis basedir", WhereisBaseDir)
, ("whereis bindir", WhereisBinDir)
, ("whereis cachedir", WhereisCacheDir)
, ("whereis logsdir", WhereisLogsDir)
, ("whereis confdir", WhereisConfDir)
]
where
mk :: (String, WhereisCommand) -> [(String, (WhereisOptions, WhereisCommand))]
mk (cmd, res) =
[ (cmd, (WhereisOptions False, res))
, (cmd <> " -d", (WhereisOptions True, res))
, (cmd <> " --directory", (WhereisOptions True, res))
]
whereisParseWith :: [String] -> IO (WhereisOptions, WhereisCommand)
whereisParseWith args = do
Whereis a b <- parseWith args
pure (a, b)