Set test
This commit is contained in:
Lei Zhu
parent
c10924274d
commit
83b82c328b
|
|
@ -414,8 +414,9 @@ test-suite ghcup-test
|
|||
test-suite ghcup-optparse-test
|
||||
type: exitcode-stdio-1.0
|
||||
hs-source-dirs: test/optparse-test
|
||||
build-tool-depends: ghcup:ghcup
|
||||
main-is: Main.hs
|
||||
other-modules:
|
||||
SetTest
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
||||
|
|
@ -1,75 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import GHCup.OptParse as GHCup
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Options.Applicative
|
||||
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||
import GHCup.Types
|
||||
import Data.Versions
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
|
||||
import qualified SetTest
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain setTests
|
||||
|
||||
setTests :: TestTree
|
||||
setTests =
|
||||
testGroup "set"
|
||||
[ check "set" (Right $ SetOptions SetRecommended)
|
||||
, check "set ghc" (Left $ SetGHC $ SetOptions SetRecommended)
|
||||
, check "set ghc-9.2" (Right $ SetOptions
|
||||
$ SetGHCVersion
|
||||
(GHCTargetVersion (Just "ghc")
|
||||
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])))
|
||||
, check "set next" (Right $ SetOptions SetNext)
|
||||
, check "set latest" (Right $ SetOptions $ SetToolTag Latest)
|
||||
, check "set ghc-javascript-unknown-ghcjs-9.6"
|
||||
(Right $ SetOptions
|
||||
$ SetGHCVersion
|
||||
(GHCTargetVersion
|
||||
(Just "ghc-javascript-unknown-ghcjs")
|
||||
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []])
|
||||
)
|
||||
)
|
||||
, check "set next" (Right $ SetOptions SetNext)
|
||||
, check "set nightly" (Right $ SetOptions
|
||||
$ SetGHCVersion
|
||||
(GHCTargetVersion
|
||||
Nothing
|
||||
(mkVersion $ (Str "nightly" :| []) :| [])
|
||||
)
|
||||
)
|
||||
, check "set cabal-3.10"
|
||||
(Right $ SetOptions
|
||||
$ SetGHCVersion
|
||||
(GHCTargetVersion
|
||||
(Just "cabal")
|
||||
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []])
|
||||
)
|
||||
)
|
||||
, check "set latest" (Right $ SetOptions $ SetToolTag Latest)
|
||||
]
|
||||
where
|
||||
check :: String -> Either SetCommand SetOptions -> TestTree
|
||||
check args expected = testCase args $ do
|
||||
res <- setParseWith (words args)
|
||||
liftIO $ res @?= expected
|
||||
|
||||
mkVersion :: NonEmpty VChunk -> Version
|
||||
mkVersion chunks = Version Nothing chunks [] Nothing
|
||||
|
||||
checkList :: [(String, Either SetCommand SetOptions)]
|
||||
checkList = undefined
|
||||
|
||||
setParseWith :: [String] -> IO (Either SetCommand SetOptions)
|
||||
setParseWith args = do
|
||||
Set a <- parseWith args
|
||||
pure a
|
||||
|
||||
parseWith :: [String] -> IO Command
|
||||
parseWith args =
|
||||
optCommand <$> handleParseResult
|
||||
(execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
|
||||
main = defaultMain SetTest.setTests
|
||||
|
|
@ -0,0 +1,204 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module SetTest where
|
||||
|
||||
import GHCup.OptParse as GHCup
|
||||
import Test.Tasty
|
||||
import Test.Tasty.HUnit
|
||||
import Options.Applicative
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import GHCup.Types
|
||||
import Data.Versions
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)))
|
||||
import Data.Bifunctor (second)
|
||||
|
||||
setTests :: TestTree
|
||||
setTests =
|
||||
testGroup "set"
|
||||
$ map
|
||||
buildTestTree
|
||||
[ ("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
|
||||
|
||||
mkVersion :: NonEmpty VChunk -> Version
|
||||
mkVersion chunks = Version Nothing chunks [] Nothing
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
Loading…
Reference in New Issue