diff --git a/app/ghcup/GHCup/OptParse/Install.hs b/app/ghcup/GHCup/OptParse/Install.hs index e13f740..9cf68ba 100644 --- a/app/ghcup/GHCup/OptParse/Install.hs +++ b/app/ghcup/GHCup/OptParse/Install.hs @@ -54,6 +54,7 @@ data InstallCommand = InstallGHC InstallOptions | InstallCabal InstallOptions | InstallHLS InstallOptions | InstallStack InstallOptions + deriving (Eq, Show) @@ -70,7 +71,7 @@ data InstallOptions = InstallOptions , isolateDir :: Maybe FilePath , forceInstall :: Bool , addConfArgs :: [T.Text] - } + } deriving (Eq, Show) diff --git a/ghcup.cabal b/ghcup.cabal index cf7b086..5bc4b80 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -421,6 +421,7 @@ test-suite ghcup-optparse-test OtherCommandTest ChangeLogTest ConfigTest + InstallTest default-language: Haskell2010 ghc-options: -Wall build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text, uri-bytestring diff --git a/test/optparse-test/InstallTest.hs b/test/optparse-test/InstallTest.hs new file mode 100644 index 0000000..5dcfe35 --- /dev/null +++ b/test/optparse-test/InstallTest.hs @@ -0,0 +1,218 @@ +{-# 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}) + : ("install -i /", Right defaultOptions{Install.isolateDir = Just "/"}) + : ("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 diff --git a/test/optparse-test/Main.hs b/test/optparse-test/Main.hs index d75eb12..ca877b6 100644 --- a/test/optparse-test/Main.hs +++ b/test/optparse-test/Main.hs @@ -5,6 +5,7 @@ import qualified SetTest import qualified OtherCommandTest import qualified ChangeLogTest import qualified ConfigTest +import qualified InstallTest main :: IO () main = defaultMain $ testGroup "ghcup" @@ -12,4 +13,5 @@ main = defaultMain $ testGroup "ghcup" , OtherCommandTest.otherCommandTests , ChangeLogTest.changeLogTests , ConfigTest.configTests + , InstallTest.installTests ] diff --git a/test/optparse-test/SetTest.hs b/test/optparse-test/SetTest.hs index 767797a..cb0cd63 100644 --- a/test/optparse-test/SetTest.hs +++ b/test/optparse-test/SetTest.hs @@ -2,10 +2,8 @@ module SetTest where -import GHCup.OptParse as GHCup +import GHCup.OptParse import Test.Tasty -import Test.Tasty.HUnit -import Control.Monad.IO.Class (liftIO) import GHCup.Types import Data.Versions import Data.List.NonEmpty (NonEmpty ((:|))) @@ -15,23 +13,13 @@ setTests :: TestTree setTests = testGroup "set" $ map - buildTestTree + (buildTestTree setParseWith) [ ("old-style", oldStyleCheckList) , ("ghc", setGhcCheckList) , ("cabal", setCabalCheckList) , ("hls", setHlsCheckList) , ("stack", setStackCheckList) ] - where - buildTestTree :: (String, [(String, Either SetCommand SetOptions)]) -> TestTree - buildTestTree (title, checkList) = - testGroup title - $ zipWith (uncurry . check) [1 :: Int ..] checkList - - check :: Int -> String -> Either SetCommand SetOptions -> TestTree - check idx args expected = testCase (padLeft 2 (show idx) ++ "." ++ args) $ do - res <- setParseWith (words args) - liftIO $ res @?= expected oldStyleCheckList :: [(String, Either SetCommand SetOptions)] oldStyleCheckList = mapSecond (Right . SetOptions) diff --git a/test/optparse-test/Utils.hs b/test/optparse-test/Utils.hs index 01bd76f..6f56ec8 100644 --- a/test/optparse-test/Utils.hs +++ b/test/optparse-test/Utils.hs @@ -5,6 +5,9 @@ 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 parseWith :: [String] -> IO Command parseWith args = @@ -20,3 +23,16 @@ mapSecond = map . second mkVersion :: NonEmpty VChunk -> Version mkVersion chunks = Version Nothing chunks [] Nothing + +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