Compare commits

...

5 Commits

Author SHA1 Message Date
16ae69e994
Fix property tests 2023-10-13 18:08:16 +08:00
94888e9d8e
Add temp git ref to versions to fix CI 2023-10-13 17:52:39 +08:00
Colin Woodbury
cc7cc8c0e4 refactor: use upstream TH constructors 2023-10-13 17:35:39 +09:00
Colin Woodbury
28cb01539d chore: bump versions upper bound and squash warnings 2023-10-13 17:31:17 +09:00
Colin Woodbury
8aa05f311e refactor: upgrade versions library usage 2023-10-13 17:09:35 +09:00
24 changed files with 155 additions and 256 deletions

View File

@ -45,7 +45,7 @@ import Data.IORef
import Data.Vector ( Vector import Data.Vector ( Vector
, (!?) , (!?)
) )
import Data.Versions hiding ( str ) import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )
import System.FilePath import System.FilePath

View File

@ -8,6 +8,11 @@ package ghcup
constraints: http-io-streams -brotli, constraints: http-io-streams -brotli,
any.aeson >= 2.0.1.0 any.aeson >= 2.0.1.0
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
package libarchive package libarchive
flags: -system-libarchive flags: -system-libarchive

View File

@ -4,6 +4,11 @@ optional-packages: ./vendored/*/*.cabal
optimization: 2 optimization: 2
source-repository-package
type: git
location: https://github.com/fosskers/versions.git
tag: 7bc3355348aac3510771d4622aff09ac38c9924d
if os(linux) if os(linux)
package ghcup package ghcup
flags: +tui flags: +tui

View File

@ -87,7 +87,7 @@ common app-common-depends
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, utf8-string ^>=1.0 , utf8-string ^>=1.0
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=6.0.3 && <6.1
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
library library
@ -189,7 +189,7 @@ library
, unordered-containers ^>=0.2.10.0 , unordered-containers ^>=0.2.10.0
, uri-bytestring ^>=0.3.2.2 , uri-bytestring ^>=0.3.2.2
, vector ^>=0.12 , vector ^>=0.12
, versions >=4.0.1 && <5.1 , versions >=6.0.3 && <6.1
, word8 ^>=0.1.3 , word8 ^>=0.1.3
, yaml-streamly ^>=0.12.0 , yaml-streamly ^>=0.12.0
, zlib ^>=0.6.2.2 , zlib ^>=0.6.2.2
@ -377,7 +377,7 @@ test-suite ghcup-test
, text ^>=2.0 , text ^>=2.0
, time >=1.9.3 && <1.12 , 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 >=6.0.3 && <6.1
if os(windows) if os(windows)
cpp-options: -DIS_WINDOWS cpp-options: -DIS_WINDOWS
@ -417,6 +417,7 @@ test-suite ghcup-optparse-test
, optparse-applicative , optparse-applicative
, tasty , tasty
, tasty-hunit , tasty-hunit
, template-haskell
, text , text
, uri-bytestring , uri-bytestring
, versions , versions

View File

@ -48,7 +48,7 @@ import Data.Maybe
import Data.Text ( Text ) import Data.Text ( Text )
import Data.Time.Calendar ( Day ) import Data.Time.Calendar ( Day )
import Data.Time.Format ( parseTimeM, defaultTimeLocale ) import Data.Time.Format ( parseTimeM, defaultTimeLocale )
import Data.Versions hiding ( str ) import Data.Versions
import Data.Void import Data.Void
import qualified Data.Vector as V import qualified Data.Vector as V
import GHC.IO.Exception import GHC.IO.Exception

View File

@ -27,7 +27,7 @@ import Data.List ( intercalate, sort )
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Time.Calendar ( Day ) import Data.Time.Calendar ( Day )
import Data.Versions hiding ( str ) import Data.Versions
import Data.Void import Data.Void
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )

View File

@ -29,7 +29,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( str ) import Data.Versions
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )
import Prelude hiding ( appendFile ) import Prelude hiding ( appendFile )

View File

@ -28,7 +28,7 @@ import Control.Monad.Trans.Resource
import Data.Either import Data.Either
import Data.Functor import Data.Functor
import Data.Maybe import Data.Maybe
import Data.Versions hiding ( str ) import Data.Versions
import GHC.Unicode import GHC.Unicode
import Haskus.Utils.Variant.Excepts import Haskus.Utils.Variant.Excepts
import Options.Applicative hiding ( style ) import Options.Applicative hiding ( style )

View File

@ -35,7 +35,7 @@ import System.Environment
import GHCup.Utils import GHCup.Utils
import System.FilePath import System.FilePath
import GHCup.Types.Optics import GHCup.Types.Optics
import Data.Versions hiding (str) import Data.Versions

View File

@ -717,8 +717,10 @@ getCabalVersion fp = do
gpd <- case parseGenericPackageDescriptionMaybe contents of gpd <- case parseGenericPackageDescriptionMaybe contents of
Nothing -> fail $ "could not parse cabal file: " <> fp Nothing -> fail $ "could not parse cabal file: " <> fp
Just r -> pure r Just r -> pure r
let tver = (\c -> Version Nothing c [] Nothing) let tver = (\c -> Version Nothing c Nothing Nothing)
. NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral) . Chunks
. NE.fromList
. fmap (Numeric . fromIntegral)
. versionNumbers . versionNumbers
. pkgVersion . pkgVersion
. package . package

View File

@ -91,18 +91,16 @@ ghcTargetVerP =
verP' :: MP.Parsec Void Text Text verP' :: MP.Parsec Void Text Text
verP' = do verP' = do
v <- version' v <- version'
let startsWithDigists = let startsWithDigits =
and and
. take 3 . take 3
. concatMap . map (\case
(map Numeric _ -> True
(\case Alphanum _ -> False)
(Digits _) -> True
(Str _) -> False
) . NE.toList)
. NE.toList . NE.toList
. (\(Chunks nec) -> nec)
$ _vChunks v $ _vChunks v
if startsWithDigists && isNothing (_vEpoch v) if startsWithDigits && isNothing (_vEpoch v)
then pure $ prettyVer v then pure $ prettyVer v
else fail "Oh" else fail "Oh"

View File

@ -26,36 +26,14 @@ import GHC.Base
#endif #endif
import Language.Haskell.TH import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) ) import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Language.Haskell.TH.Syntax ( Lift import Language.Haskell.TH.Syntax ( dataToExpQ )
, dataToExpQ
)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Language.Haskell.TH.Syntax as TH import qualified Language.Haskell.TH.Syntax as TH
deriving instance Data Versioning
deriving instance Lift Versioning
deriving instance Data Version
deriving instance Lift Version
deriving instance Data SemVer
deriving instance Lift SemVer
deriving instance Data Mess
deriving instance Lift Mess
deriving instance Data MChunk
deriving instance Lift MChunk
deriving instance Data PVP
deriving instance Lift PVP
deriving instance Lift VSep
deriving instance Data VSep
deriving instance Lift VUnit
deriving instance Data VUnit
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
deriving instance Lift (NonEmpty Word) deriving instance Lift (NonEmpty Word)
deriving instance Lift (NonEmpty VChunk)
deriving instance Lift (NonEmpty MChunk) deriving instance Lift (NonEmpty MChunk)
deriving instance Lift (NonEmpty VUnit)
#endif #endif
qq :: (Text -> Q Exp) -> QuasiQuoter qq :: (Text -> Q Exp) -> QuasiQuoter

View File

@ -48,10 +48,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool

View File

@ -119,11 +119,11 @@ import Data.Time (Day(..), diffDays, addDays)
-- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False } -- >>> let lc = LoggerConfig { lcPrintDebug = False, consoleOutter = mempty, fileOutter = mempty, fancyColors = False }
-- >>> dirs' <- getAllDirs -- >>> dirs' <- getAllDirs
-- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ] -- >>> let installedVersions = [ ([pver|8.10.7|], "-debug+lol", Nothing), ([pver|8.10.4|], "", Nothing), ([pver|8.8.4|], "", Nothing), ([pver|8.8.3|], "", Nothing) ]
-- >>> let settings = Settings True 0 False Never Curl False GHCupURL True GPGNone False -- >>> let settings = defaultSettings { cache = True, metaCache = 0, noNetwork = True }
-- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc -- >>> let leanAppState = LeanAppState settings dirs' defaultKeyBindings lc
-- >>> cwd <- getCurrentDirectory -- >>> cwd <- getCurrentDirectory
-- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL) -- >>> (Right ref) <- pure $ parseURI strictURIParserOptions $ "file://" <> E.encodeUtf8 (T.pack cwd) <> "/data/metadata/" <> (urlBaseName . view pathL' $ ghcupURL)
-- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError] $ liftE $ getBase ref -- >>> (VRight r) <- (fmap . fmap) _ghcupDownloads $ flip runReaderT leanAppState . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError, ContentLengthError] $ liftE $ getBase ref
@ -687,10 +687,8 @@ hlsAllBinaries ver = do
-- | Extract (major, minor) from any version. -- | Extract (major, minor) from any version.
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version {..} = case _vChunks of getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y)
((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y) getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version"
_ -> throwM $ ParseError "Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool matchMajor :: Version -> Int -> Int -> Bool
matchMajor v' major' minor' = case getMajorMinorV v' of matchMajor v' major' minor' = case getMajorMinorV v' of
@ -732,7 +730,7 @@ getGHCForPVP pvpIn mt = do
-- | Like 'getGHCForPVP', except with explicit input parameter. -- | Like 'getGHCForPVP', except with explicit input parameter.
-- --
-- >>> getGHCForPVP' [pver|8|] installedVersions Nothing -- >>> getGHCForPVP' [pver|8|] installedVersions Nothing
-- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = (Digits 8 :| []) :| [Digits 10 :| [],Digits 7 :| []], _vRel = [Str "debug" :| []], _vMeta = Just "lol"}}) -- Just (GHCTargetVersion {_tvTarget = Nothing, _tvVersion = Version {_vEpoch = Nothing, _vChunks = Chunks (Numeric 8 :| [Numeric 10,Numeric 7]), _vRel = Just (Release (Alphanum "debug" :| [])), _vMeta = Just "lol"}})
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.8|] installedVersions Nothing
-- "Just 8.8.4" -- "Just 8.8.4"
-- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing -- >>> fmap prettyShow $ getGHCForPVP' [pver|8.10.4|] installedVersions Nothing
@ -758,11 +756,11 @@ getGHCForPVP' pvpIn ghcs' mt = do
-- | Get the latest available ghc for the given PVP version, which -- | Get the latest available ghc for the given PVP version, which
-- may only contain parts. -- may only contain parts.
-- --
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8|] r
-- Just (PVP {_pComponents = 8 :| [10,7]}) -- Just (PVP {_pComponents = 8 :| [10,7]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8|] r
-- Just (PVP {_pComponents = 8 :| [8,4]}) -- Just (PVP {_pComponents = 8 :| [8,4]})
-- >>> (fmap . fmap) fst $ getLatestToolFor GHC [pver|8.8.4|] r -- >>> (fmap . fmap) (\(p, _, _) -> p) $ getLatestToolFor GHC Nothing [pver|8.8.4|] r
-- Just (PVP {_pComponents = 8 :| [8,4]}) -- Just (PVP {_pComponents = 8 :| [8,4]})
getLatestToolFor :: MonadThrow m getLatestToolFor :: MonadThrow m
=> Tool => Tool

View File

@ -24,10 +24,10 @@ import qualified Data.Text as T
import qualified Data.Versions as V import qualified Data.Versions as V
import Control.Exception.Safe (MonadThrow) import Control.Exception.Safe (MonadThrow)
import Data.Text (Text) import Data.Text (Text)
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.List (intersperse)
import Control.Monad.Catch (throwM) import Control.Monad.Catch (throwM)
import GHCup.Errors (ParseError(..)) import GHCup.Errors (ParseError(..))
import Text.Megaparsec
import Data.Void (Void)
-- | This reflects the API version of the YAML. -- | This reflects the API version of the YAML.
-- --
@ -65,44 +65,15 @@ pvpToVersion pvp_ rest =
-- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v -- -- prop> \v -> let (Just (pvp', r)) = versionToPVP v in pvpToVersion pvp' r === Just v
versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text) versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text)
versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch" versionToPVP (V.Version (Just _) _ _ _) = throwM $ ParseError "Unexpected epoch"
versionToPVP v = either (\_ -> (, rest v) <$> alternative v) (pure . (, mempty)) . V.pvp . V.prettyVer $ v versionToPVP v = case parse pvp'' "Version->PVP" $ V.prettyVer v of
Left _ -> throwM $ ParseError "Couldn't convert Version to PVP"
Right r -> pure r
where where
alternative :: MonadThrow m => V.Version -> m V.PVP pvp'' :: Parsec Void T.Text (V.PVP, T.Text)
alternative v' = case NE.takeWhile isDigit (V._vChunks v') of pvp'' = do
[] -> throwM $ ParseError "Couldn't convert Version to PVP" p <- V.pvp'
xs -> pure $ pvpFromList (unsafeDigit <$> xs) s <- getParserState
pure (p, stateInput s)
rest :: V.Version -> Text
rest (V.Version _ cs pr me) =
let chunks = NE.dropWhile isDigit cs
ver = intersperse (T.pack ".") . chunksAsT $ chunks
me' = maybe [] (\m -> [T.pack "+",m]) me
pr' = foldable [] (T.pack "-" :) $ intersperse (T.pack ".") (chunksAsT pr)
prefix = case (ver, pr', me') of
(_:_, _, _) -> T.pack "."
_ -> T.pack ""
in prefix <> mconcat (ver <> pr' <> me')
where
chunksAsT :: Functor t => t V.VChunk -> t Text
chunksAsT = fmap (foldMap f)
where
f :: V.VUnit -> Text
f (V.Digits i) = T.pack $ show i
f (V.Str s) = s
foldable :: Foldable f => f b -> (f a -> f b) -> f a -> f b
foldable d g f | null f = d
| otherwise = g f
isDigit :: V.VChunk -> Bool
isDigit (V.Digits _ :| []) = True
isDigit _ = False
unsafeDigit :: V.VChunk -> Int
unsafeDigit (V.Digits x :| []) = fromIntegral x
unsafeDigit _ = error "unsafeDigit: wrong input"
pvpFromList :: [Int] -> V.PVP pvpFromList :: [Int] -> V.PVP
pvpFromList = V.PVP . NE.fromList . fmap fromIntegral pvpFromList = V.PVP . NE.fromList . fmap fromIntegral

View File

@ -24,6 +24,8 @@ extra-deps:
- strict-base-0.4.0.0 - strict-base-0.4.0.0
- text-2.0.2 - text-2.0.2
- yaml-streamly-0.12.2 - yaml-streamly-0.12.2
- github: fosskers/versions
commit: 7bc3355348aac3510771d4622aff09ac38c9924d
flags: flags:
http-io-streams: http-io-streams:

View File

@ -1,3 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module ChangeLogTest where module ChangeLogTest where
import Test.Tasty import Test.Tasty
@ -6,8 +9,7 @@ import Utils
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Control.Monad.IO.Class import Control.Monad.IO.Class
import GHCup.Types import GHCup.Types
import Data.Versions import Data.Versions (versionQ)
import Data.List.NonEmpty (NonEmpty ((:|)))
changeLogTests :: TestTree changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
@ -30,7 +32,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])) $(versionQ "9.2"))
) )
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended)) , ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended)) , ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
@ -38,7 +40,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []])) $(versionQ "3.10.1.0"))
) )
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22")))) , ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
] ]

View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module CompileTest where module CompileTest where
@ -59,12 +60,12 @@ compileGhcCheckList = mapSecond CompileGHC
[ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions) [ ("compile ghc -v 9.4.5 -b 9.2.8", baseOptions)
, ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions , ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" Nothing) (GHC.GitDist $ GitBranch "a32db0b" Nothing)
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git", , ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
(GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git")) (GHC.GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2", , ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
@ -73,7 +74,7 @@ compileGhcCheckList = mapSecond CompileGHC
) )
, ("compile ghc --remote-source-dist https://gitlab.haskell.org/ghc/ghc.git -b 9.2.8", mkDefaultGHCCompileOptions , ("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|]) (GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|])
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
) )
, (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20}) , (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10}) , (baseCmd <> "--jobs 10", baseOptions{GHC.jobs = Just 10})
@ -86,8 +87,8 @@ compileGhcCheckList = mapSecond CompileGHC
, (baseCmd <> "--cross-target 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 <> "-- --enable-unregisterised", baseOptions{GHC.addConfArgs = ["--enable-unregisterised"]})
, (baseCmd <> "--set", baseOptions{GHC.setCompile = True}) , (baseCmd <> "--set", baseOptions{GHC.setCompile = True})
, (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"}) , (baseCmd <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $ mkVersion' "9.4.5-p1"}) , (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(versionQ "9.4.5-p1")})
, (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"}) , (baseCmd <> "-f make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"}) , (baseCmd <> "--flavour make", baseOptions{GHC.buildFlavour = Just "make"})
, (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian}) , (baseCmd <> "--hadrian", baseOptions{GHC.buildSystem = Just Hadrian})
@ -107,8 +108,8 @@ compileGhcCheckList = mapSecond CompileGHC
baseOptions :: GHCCompileOptions baseOptions :: GHCCompileOptions
baseOptions = baseOptions =
mkDefaultGHCCompileOptions mkDefaultGHCCompileOptions
(GHC.SourceDist $ mkVersion' "9.4.5") (GHC.SourceDist $(versionQ "9.4.5"))
(Left $ mkVersion' "9.2.8") (Left $(versionQ "9.2.8"))
compileHlsCheckList :: [(String, CompileCommand)] compileHlsCheckList :: [(String, CompileCommand)]
compileHlsCheckList = mapSecond CompileHLS compileHlsCheckList = mapSecond CompileHLS
@ -136,7 +137,7 @@ compileHlsCheckList = mapSecond CompileHLS
) )
, ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8", , ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8",
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.SourceDist $ mkVersion' "2.0.0.0") (HLS.SourceDist $(versionQ "2.0.0.0"))
[ghc928] [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", , ("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",
@ -146,15 +147,15 @@ compileHlsCheckList = mapSecond CompileHLS
) )
, ("compile hls -v 2.0.0.0 --ghc latest", , ("compile hls -v 2.0.0.0 --ghc latest",
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0") (HLS.HackageDist $(versionQ "2.0.0.0"))
[ToolTag Latest] [ToolTag Latest]
) )
, (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20}) , (baseCmd <> "-j20", baseOptions{HLS.jobs = Just 20})
, (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10}) , (baseCmd <> "--jobs 10", baseOptions{HLS.jobs = Just 10})
, (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False}) , (baseCmd <> "--no-set", baseOptions{HLS.setCompile = False})
, (baseCmd <> "--cabal-update", baseOptions{HLS.updateCabal = True}) , (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 <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--overwrite-version 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 $(versionQ "2.0.0.0-p1")})
, (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True}) , (baseCmd <> "--git-describe-version", baseOptions{HLS.ovewrwiteVer = Left True})
#ifdef IS_WINDOWS #ifdef IS_WINDOWS
, (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"}) , (baseCmd <> "-i C:\\\\tmp\\out_dir", baseOptions{HLS.isolateDir = Just "C:\\\\tmp\\out_dir"})
@ -178,11 +179,11 @@ compileHlsCheckList = mapSecond CompileHLS
baseOptions :: HLSCompileOptions baseOptions :: HLSCompileOptions
baseOptions = baseOptions =
mkDefaultHLSCompileOptions mkDefaultHLSCompileOptions
(HLS.HackageDist $ mkVersion' "2.0.0.0") (HLS.HackageDist $(versionQ "2.0.0.0"))
[ghc928] [ghc928]
ghc928 :: ToolVersion ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8") ghc928 = GHCVersion $ GHCTargetVersion Nothing $(versionQ "9.2.8")
compileParseWith :: [String] -> IO CompileCommand compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do compileParseWith args = do

View File

@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module InstallTest where module InstallTest where
@ -54,7 +55,7 @@ oldStyleCheckList =
: ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head" : ("install -u https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz head"
, Right defaultOptions , Right defaultOptions
{ instBindist = Just [uri|https://gitlab.haskell.org/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz|] { 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" :| []) :| []) , instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(versionQ "head")
} }
) )
: mapSecond : mapSecond
@ -62,48 +63,48 @@ oldStyleCheckList =
[ ("install ghc-9.2", GHCVersion [ ("install ghc-9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
-- invalid -- invalid
, ("install next", GHCVersion , ("install next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(versionQ "next")
) )
, ("install latest", ToolTag Latest) , ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion , ("install nightly", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("install recommended", ToolTag Recommended) , ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion , ("install prerelease", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("install latest-prerelease", ToolTag LatestPrerelease) , ("install latest-prerelease", ToolTag LatestPrerelease)
, ("install latest-nightly", ToolTag LatestNightly) , ("install latest-nightly", ToolTag LatestNightly)
, ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion , ("install ghc-javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs") (Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal-3.10", GHCVersion , ("install cabal-3.10", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "cabal") (Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) $(versionQ "3.10")
) )
, ("install hls-2.0.0.0", GHCVersion , ("install hls-2.0.0.0", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "hls") (Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) $(versionQ "2.0.0.0")
) )
, ("install stack-2.9.3", GHCVersion , ("install stack-2.9.3", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "stack") (Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) $(versionQ "2.9.3")
) )
] ]
@ -114,37 +115,37 @@ installGhcCheckList =
[ ("install ghc 9.2", GHCVersion [ ("install ghc 9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("install ghc next", GHCVersion , ("install ghc next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(versionQ "next")
) )
, ("install ghc latest", ToolTag Latest) , ("install ghc latest", ToolTag Latest)
, ("install ghc nightly", GHCVersion , ("install ghc nightly", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("install ghc recommended", ToolTag Recommended) , ("install ghc recommended", ToolTag Recommended)
, ("install ghc prerelease", GHCVersion , ("install ghc prerelease", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("install ghc latest-prerelease", ToolTag LatestPrerelease) , ("install ghc latest-prerelease", ToolTag LatestPrerelease)
, ("install ghc latest-nightly", ToolTag LatestNightly) , ("install ghc latest-nightly", ToolTag LatestNightly)
, ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion , ("install ghc javascript-unknown-ghcjs-9.6", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "javascript-unknown-ghcjs") (Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install ghc base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install ghc ghc-9.2", GHCVersion , ("install ghc ghc-9.2", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
] ]
@ -152,69 +153,48 @@ installCabalCheckList :: [(String, Either InstallCommand InstallOptions)]
installCabalCheckList = installCabalCheckList =
("install cabal", Left $ InstallCabal defaultOptions{instSet = True}) ("install cabal", Left $ InstallCabal defaultOptions{instSet = True})
: mapSecond (Left . InstallCabal . mkInstallOptions') : mapSecond (Left . InstallCabal . mkInstallOptions')
[ ("install cabal 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install cabal 3.10", ToolVersion $(versionQ "3.10"))
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install cabal next", ToolVersion $(versionQ "next"))
, ("install cabal latest", ToolTag Latest) , ("install cabal latest", ToolTag Latest)
, ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install cabal nightly", ToolVersion $(versionQ "nightly"))
, ("install cabal recommended", ToolTag Recommended) , ("install cabal recommended", ToolTag Recommended)
, ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install cabal prerelease", ToolVersion $(versionQ "prerelease"))
, ("install cabal latest-prerelease", ToolTag LatestPrerelease) , ("install cabal latest-prerelease", ToolTag LatestPrerelease)
, ("install cabal latest-nightly", ToolTag LatestNightly) , ("install cabal latest-nightly", ToolTag LatestNightly)
, ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install cabal base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install cabal cabal-3.10", ToolVersion , ("install cabal cabal-3.10", ToolVersion $(versionQ "cabal-3.10"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
installHlsCheckList :: [(String, Either InstallCommand InstallOptions)] installHlsCheckList :: [(String, Either InstallCommand InstallOptions)]
installHlsCheckList = installHlsCheckList =
("install hls", Left $ InstallHLS defaultOptions{instSet = True}) ("install hls", Left $ InstallHLS defaultOptions{instSet = True})
: mapSecond (Left . InstallHLS . mkInstallOptions') : mapSecond (Left . InstallHLS . mkInstallOptions')
[ ("install hls 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install hls 3.10", ToolVersion $(versionQ "3.10"))
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install hls next", ToolVersion $(versionQ "next"))
, ("install hls latest", ToolTag Latest) , ("install hls latest", ToolTag Latest)
, ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install hls nightly", ToolVersion $(versionQ "nightly"))
, ("install hls recommended", ToolTag Recommended) , ("install hls recommended", ToolTag Recommended)
, ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install hls prerelease", ToolVersion $(versionQ "prerelease"))
, ("install hls latest-prerelease", ToolTag LatestPrerelease) , ("install hls latest-prerelease", ToolTag LatestPrerelease)
, ("install hls latest-nightly", ToolTag LatestNightly) , ("install hls latest-nightly", ToolTag LatestNightly)
, ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install hls base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install hls hls-2.0", ToolVersion , ("install hls hls-2.0", ToolVersion $(versionQ "hls-2.0"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
installStackCheckList :: [(String, Either InstallCommand InstallOptions)] installStackCheckList :: [(String, Either InstallCommand InstallOptions)]
installStackCheckList = installStackCheckList =
("install stack", Left $ InstallStack defaultOptions{instSet = True}) ("install stack", Left $ InstallStack defaultOptions{instSet = True})
: mapSecond (Left . InstallStack . mkInstallOptions') : mapSecond (Left . InstallStack . mkInstallOptions')
[ ("install stack 3.10", ToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) [ ("install stack 3.10", ToolVersion $(versionQ "3.10"))
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install stack next", ToolVersion $(versionQ "next"))
, ("install stack latest", ToolTag Latest) , ("install stack latest", ToolTag Latest)
, ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("install stack nightly", ToolVersion $(versionQ "nightly"))
, ("install stack recommended", ToolTag Recommended) , ("install stack recommended", ToolTag Recommended)
, ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("install stack prerelease", ToolVersion $(versionQ "prerelease"))
, ("install stack latest-prerelease", ToolTag LatestPrerelease) , ("install stack latest-prerelease", ToolTag LatestPrerelease)
, ("install stack latest-nightly", ToolTag LatestNightly) , ("install stack latest-nightly", ToolTag LatestNightly)
, ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install stack base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("install stack stack-2.9", ToolVersion , ("install stack stack-2.9", ToolVersion $(versionQ "stack-2.9"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
] ]
installParseWith :: [String] -> IO (Either InstallCommand InstallOptions) installParseWith :: [String] -> IO (Either InstallCommand InstallOptions)

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module RmTest where module RmTest where
@ -6,7 +7,6 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.Versions import Data.Versions
@ -24,54 +24,36 @@ rmTests =
oldStyleCheckList :: [(String, Either RmCommand RmOptions)] oldStyleCheckList :: [(String, Either RmCommand RmOptions)]
oldStyleCheckList = mapSecond (Right . RmOptions) oldStyleCheckList = mapSecond (Right . RmOptions)
[ -- failed with ("rm", xxx) [ -- failed with ("rm", xxx)
("rm 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) ("rm 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) , ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
] ]
rmGhcCheckList :: [(String, Either RmCommand RmOptions)] rmGhcCheckList :: [(String, Either RmCommand RmOptions)]
rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions) rmGhcCheckList = mapSecond (Left . RmGHC . RmOptions)
[ -- failed with ("rm ghc", xxx) [ -- failed with ("rm ghc", xxx)
("rm ghc 9.2.8", mkTVer (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) ("rm ghc 9.2.8", mkTVer $(versionQ "9.2.8"))
, ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| [], Digits 8 :| []])) , ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") $(versionQ "9.2.8"))
] ]
rmCabalCheckList :: [(String, Either RmCommand RmOptions)] rmCabalCheckList :: [(String, Either RmCommand RmOptions)]
rmCabalCheckList = mapSecond (Left . RmCabal) rmCabalCheckList = mapSecond (Left . RmCabal)
[ -- failed with ("rm cabal", xxx) [ -- failed with ("rm cabal", xxx)
("rm cabal 3.10", mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) ("rm cabal 3.10", $(versionQ "3.10"))
, ("rm cabal cabal-3.10", Version , ("rm cabal cabal-3.10", $(versionQ "cabal-3.10"))
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
rmHlsCheckList :: [(String, Either RmCommand RmOptions)] rmHlsCheckList :: [(String, Either RmCommand RmOptions)]
rmHlsCheckList = mapSecond (Left . RmHLS) rmHlsCheckList = mapSecond (Left . RmHLS)
[ -- failed with ("rm hls", xxx) [ -- failed with ("rm hls", xxx)
("rm hls 2.0", mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []]) ("rm hls 2.0", $(versionQ "2.0"))
, ("rm hls hls-2.0", Version , ("rm hls hls-2.0", $(versionQ "hls-2.0"))
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
rmStackCheckList :: [(String, Either RmCommand RmOptions)] rmStackCheckList :: [(String, Either RmCommand RmOptions)]
rmStackCheckList = mapSecond (Left . RmStack) rmStackCheckList = mapSecond (Left . RmStack)
[ -- failed with ("rm stack", xxx) [ -- failed with ("rm stack", xxx)
("rm stack 2.9.1", mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 1 :| []]) ("rm stack 2.9.1", $(versionQ "2.9.1"))
, ("rm stack stack-2.9.1", Version , ("rm stack stack-2.9.1", $(versionQ "stack-2.9.1"))
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| [], Digits 1 :| []]
, _vMeta = Nothing
}
)
] ]
rmParseWith :: [String] -> IO (Either RmCommand RmOptions) rmParseWith :: [String] -> IO (Either RmCommand RmOptions)

View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module RunTest where module RunTest where
@ -7,6 +8,7 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.Versions (versionQ)
runTests :: TestTree runTests :: TestTree
@ -35,11 +37,11 @@ runCheckList =
, ("run --install", defaultOptions{runInstTool' = True}) , ("run --install", defaultOptions{runInstTool' = True})
, ("run -m", defaultOptions{runMinGWPath = True}) , ("run -m", defaultOptions{runMinGWPath = True})
, ("run --mingw-path", 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 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")})
, ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest}) , ("run --ghc latest", defaultOptions{runGHCVer = Just $ ToolTag Latest})
, ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $ mkVersion' "3.10"}) , ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(versionQ "3.10")})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"}) , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(versionQ "2.0")})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"}) , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(versionQ "2.9") })
#ifdef IS_WINDOWS #ifdef IS_WINDOWS
, ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"}) , ("run -b C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
, ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"}) , ("run --bindir C:\\\\tmp\\dir", defaultOptions{runBinDir = Just "C:\\\\tmp\\dir"})
@ -52,9 +54,9 @@ runCheckList =
, ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install", , ("run --ghc latest --cabal 3.10 --stack 2.9 --hls 2.0 --install",
defaultOptions defaultOptions
{ runGHCVer = Just $ ToolTag Latest { runGHCVer = Just $ ToolTag Latest
, runCabalVer = Just $ ToolVersion $ mkVersion' "3.10" , runCabalVer = Just $ ToolVersion $(versionQ "3.10")
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0" , runHLSVer = Just $ ToolVersion $(versionQ "2.0")
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9" , runStackVer = Just $ ToolVersion $(versionQ "2.9")
, runInstTool' = True , runInstTool' = True
} }
) )

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module SetTest where module SetTest where
@ -27,44 +28,44 @@ oldStyleCheckList = mapSecond (Right . SetOptions)
, ("set ghc-9.2", SetGHCVersion , ("set ghc-9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("set next", SetNext) , ("set next", SetNext)
, ("set latest", SetToolTag Latest) , ("set latest", SetToolTag Latest)
, ("set nightly", SetGHCVersion , ("set nightly", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
-- different from `set` -- different from `set`
, ("set recommended", SetToolTag Recommended) , ("set recommended", SetToolTag Recommended)
, ("set prerelease", SetGHCVersion , ("set prerelease", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("set latest-prerelease", SetToolTag LatestPrerelease) , ("set latest-prerelease", SetToolTag LatestPrerelease)
, ("set latest-nightly", SetToolTag LatestNightly) , ("set latest-nightly", SetToolTag LatestNightly)
, ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion , ("set ghc-javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc-javascript-unknown-ghcjs") (Just "ghc-javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal-3.10", SetGHCVersion , ("set cabal-3.10", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "cabal") (Just "cabal")
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) $(versionQ "3.10")
) )
, ("set hls-2.0.0.0", SetGHCVersion , ("set hls-2.0.0.0", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "hls") (Just "hls")
(mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) $(versionQ "2.0.0.0")
) )
, ("set stack-2.9.3", SetGHCVersion , ("set stack-2.9.3", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "stack") (Just "stack")
(mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) $(versionQ "2.9.3")
) )
] ]
@ -74,100 +75,79 @@ setGhcCheckList = mapSecond (Left . SetGHC . SetOptions)
, ("set ghc 9.2", SetGHCVersion , ("set ghc 9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
, ("set ghc next", SetNext) , ("set ghc next", SetNext)
, ("set ghc latest", SetToolTag Latest) , ("set ghc latest", SetToolTag Latest)
, ("set ghc nightly", SetGHCVersion , ("set ghc nightly", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(versionQ "nightly")
) )
, ("set ghc recommended", SetToolTag Recommended) , ("set ghc recommended", SetToolTag Recommended)
, ("set ghc prerelease", SetGHCVersion , ("set ghc prerelease", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(versionQ "prerelease")
) )
, ("set ghc latest-prerelease", SetToolTag LatestPrerelease) , ("set ghc latest-prerelease", SetToolTag LatestPrerelease)
, ("set ghc latest-nightly", SetToolTag LatestNightly) , ("set ghc latest-nightly", SetToolTag LatestNightly)
, ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion , ("set ghc javascript-unknown-ghcjs-9.6", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "javascript-unknown-ghcjs") (Just "javascript-unknown-ghcjs")
(mkVersion $ (Digits 9 :| []) :| [Digits 6 :| []]) $(versionQ "9.6")
) )
, ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set ghc base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set ghc ghc-9.2", SetGHCVersion , ("set ghc ghc-9.2", SetGHCVersion
$ GHCTargetVersion $ GHCTargetVersion
(Just "ghc") (Just "ghc")
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) $(versionQ "9.2")
) )
] ]
setCabalCheckList :: [(String, Either SetCommand SetOptions)] setCabalCheckList :: [(String, Either SetCommand SetOptions)]
setCabalCheckList = mapSecond (Left . SetCabal . SetOptions) setCabalCheckList = mapSecond (Left . SetCabal . SetOptions)
[ ("set cabal", SetRecommended) [ ("set cabal", SetRecommended)
, ("set cabal 3.10", SetToolVersion $ mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) , ("set cabal 3.10", SetToolVersion $(versionQ "3.10"))
, ("set cabal next", SetNext) , ("set cabal next", SetNext)
, ("set cabal latest", SetToolTag Latest) , ("set cabal latest", SetToolTag Latest)
, ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set cabal nightly", SetToolVersion $(versionQ "nightly"))
, ("set cabal recommended", SetToolTag Recommended) , ("set cabal recommended", SetToolTag Recommended)
, ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set cabal prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set cabal latest-prerelease", SetToolTag LatestPrerelease) , ("set cabal latest-prerelease", SetToolTag LatestPrerelease)
, ("set cabal latest-nightly", SetToolTag LatestNightly) , ("set cabal latest-nightly", SetToolTag LatestNightly)
, ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set cabal base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set cabal cabal-3.10", SetToolVersion , ("set cabal cabal-3.10", SetToolVersion $(versionQ "cabal-3.10"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "cabal" :| []) :| []
, _vRel = [Digits 3 :| [], Digits 10 :| []]
, _vMeta = Nothing
}
)
] ]
setHlsCheckList :: [(String, Either SetCommand SetOptions)] setHlsCheckList :: [(String, Either SetCommand SetOptions)]
setHlsCheckList = mapSecond (Left . SetHLS . SetOptions) setHlsCheckList = mapSecond (Left . SetHLS . SetOptions)
[ ("set hls", SetRecommended) [ ("set hls", SetRecommended)
, ("set hls 2.0", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 0 :| []]) , ("set hls 2.0", SetToolVersion $(versionQ "2.0"))
, ("set hls next", SetNext) , ("set hls next", SetNext)
, ("set hls latest", SetToolTag Latest) , ("set hls latest", SetToolTag Latest)
, ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set hls nightly", SetToolVersion $(versionQ "nightly"))
, ("set hls recommended", SetToolTag Recommended) , ("set hls recommended", SetToolTag Recommended)
, ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set hls prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set hls latest-prerelease", SetToolTag LatestPrerelease) , ("set hls latest-prerelease", SetToolTag LatestPrerelease)
, ("set hls latest-nightly", SetToolTag LatestNightly) , ("set hls latest-nightly", SetToolTag LatestNightly)
, ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set hls base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set hls hls-2.0", SetToolVersion , ("set hls hls-2.0", SetToolVersion $(versionQ "hls-2.0"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "hls" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 0 :| []]
, _vMeta = Nothing
}
)
] ]
setStackCheckList :: [(String, Either SetCommand SetOptions)] setStackCheckList :: [(String, Either SetCommand SetOptions)]
setStackCheckList = mapSecond (Left . SetStack . SetOptions) setStackCheckList = mapSecond (Left . SetStack . SetOptions)
[ ("set stack", SetRecommended) [ ("set stack", SetRecommended)
, ("set stack 2.9", SetToolVersion $ mkVersion $ (Digits 2 :| []) :| [Digits 9 :| []]) , ("set stack 2.9", SetToolVersion $(versionQ "2.9"))
, ("set stack next", SetNext) , ("set stack next", SetNext)
, ("set stack latest", SetToolTag Latest) , ("set stack latest", SetToolTag Latest)
, ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) , ("set stack nightly", SetToolVersion $(versionQ "nightly"))
, ("set stack recommended", SetToolTag Recommended) , ("set stack recommended", SetToolTag Recommended)
, ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) , ("set stack prerelease", SetToolVersion $(versionQ "prerelease"))
, ("set stack latest-prerelease", SetToolTag LatestPrerelease) , ("set stack latest-prerelease", SetToolTag LatestPrerelease)
, ("set stack latest-nightly", SetToolTag LatestNightly) , ("set stack latest-nightly", SetToolTag LatestNightly)
, ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set stack base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]})))
, ("set stack stack-2.9", SetToolVersion , ("set stack stack-2.9", SetToolVersion $(versionQ "stack-2.9"))
$ Version
{ _vEpoch = Nothing
, _vChunks = (Str "stack" :| []) :| []
, _vRel = [Digits 2 :| [], Digits 9 :| []]
, _vMeta = Nothing
}
)
] ]
setParseWith :: [String] -> IO (Either SetCommand SetOptions) setParseWith :: [String] -> IO (Either SetCommand SetOptions)

View File

@ -4,12 +4,9 @@ module Utils where
import GHCup.OptParse as GHCup import GHCup.OptParse as GHCup
import Options.Applicative import Options.Applicative
import Data.Bifunctor import Data.Bifunctor
import Data.Versions
import Data.List.NonEmpty (NonEmpty)
import Test.Tasty import Test.Tasty
import Test.Tasty.HUnit import Test.Tasty.HUnit
import Control.Monad.IO.Class import Control.Monad.IO.Class
import qualified Data.Text as T
parseWith :: [String] -> IO Command parseWith :: [String] -> IO Command
parseWith args = parseWith args =
@ -23,14 +20,6 @@ padLeft desiredLength s = padding ++ s
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)] mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
mapSecond = map . second 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 buildTestTree
:: (Eq a, Show a) :: (Eq a, Show a)
=> ([String] -> IO a) -- ^ The parse function => ([String] -> IO a) -- ^ The parse function

View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module WhereisTest where module WhereisTest where
@ -6,6 +7,7 @@ import Test.Tasty
import GHCup.OptParse import GHCup.OptParse
import Utils import Utils
import GHCup.Types import GHCup.Types
import Data.Versions (versionQ)
whereisTests :: TestTree whereisTests :: TestTree
whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList) whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
@ -13,8 +15,8 @@ whereisTests = buildTestTree whereisParseWith ("whereis", whereisCheckList)
whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))] whereisCheckList :: [(String, (WhereisOptions, WhereisCommand))]
whereisCheckList = concatMap mk whereisCheckList = concatMap mk
[ ("whereis ghc", WhereisTool GHC Nothing) [ ("whereis ghc", WhereisTool GHC Nothing)
, ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $ mkVersion' "9.2.8")) , ("whereis ghc 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(versionQ "9.2.8")))
, ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") (mkVersion' "9.2.8"))) , ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(versionQ "9.2.8")))
, ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest)) , ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest))
, ("whereis cabal", WhereisTool Cabal Nothing) , ("whereis cabal", WhereisTool Cabal Nothing)
, ("whereis hls", WhereisTool HLS Nothing) , ("whereis hls", WhereisTool HLS Nothing)