From 8aa05f311e461739ff35bbadc9042ec2c5ee2dfd Mon Sep 17 00:00:00 2001 From: Colin Woodbury Date: Fri, 13 Oct 2023 17:09:35 +0900 Subject: [PATCH] refactor: upgrade `versions` library usage --- ghcup.cabal | 7 +-- lib/GHCup/HLS.hs | 6 ++- lib/GHCup/Prelude/MegaParsec.hs | 14 +++-- lib/GHCup/Prelude/Version/QQ.hs | 20 ------- lib/GHCup/Types/JSON.hs | 3 +- lib/GHCup/Utils.hs | 6 +-- lib/GHCup/Version.hs | 49 ++++------------- stack.yaml | 2 + test/optparse-test/ChangeLogTest.hs | 9 ++-- test/optparse-test/CompileTest.hs | 27 +++++----- test/optparse-test/InstallTest.hs | 82 +++++++++++------------------ test/optparse-test/RmTest.hs | 39 ++++---------- test/optparse-test/RunTest.hs | 15 +++--- test/optparse-test/SetTest.hs | 70 +++++++++--------------- test/optparse-test/Utils.hs | 15 +++--- test/optparse-test/WhereisTest.hs | 5 +- 16 files changed, 135 insertions(+), 234 deletions(-) diff --git a/ghcup.cabal b/ghcup.cabal index 26bef37..01ea923 100644 --- a/ghcup.cabal +++ b/ghcup.cabal @@ -87,7 +87,7 @@ common app-common-depends , uri-bytestring ^>=0.3.2.2 , utf8-string ^>=1.0 , vector ^>=0.12 - , versions >=4.0.1 && <5.1 + , versions >=4.0.1 && <6.1 , yaml-streamly ^>=0.12.0 library @@ -189,7 +189,7 @@ library , unordered-containers ^>=0.2.10.0 , uri-bytestring ^>=0.3.2.2 , vector ^>=0.12 - , versions >=4.0.1 && <5.1 + , versions >=4.0.1 && <6.1 , word8 ^>=0.1.3 , yaml-streamly ^>=0.12.0 , zlib ^>=0.6.2.2 @@ -377,7 +377,7 @@ test-suite ghcup-test , text ^>=2.0 , time >=1.9.3 && <1.12 , uri-bytestring ^>=0.3.2.2 - , versions >=4.0.1 && <5.1 + , versions >=4.0.1 && <6.1 if os(windows) cpp-options: -DIS_WINDOWS @@ -417,6 +417,7 @@ test-suite ghcup-optparse-test , optparse-applicative , tasty , tasty-hunit + , template-haskell , text , uri-bytestring , versions diff --git a/lib/GHCup/HLS.hs b/lib/GHCup/HLS.hs index ba33018..3ac6d05 100644 --- a/lib/GHCup/HLS.hs +++ b/lib/GHCup/HLS.hs @@ -717,8 +717,10 @@ getCabalVersion fp = do gpd <- case parseGenericPackageDescriptionMaybe contents of Nothing -> fail $ "could not parse cabal file: " <> fp Just r -> pure r - let tver = (\c -> Version Nothing c [] Nothing) - . NE.fromList . fmap (NE.fromList . (:[]) . digits . fromIntegral) + let tver = (\c -> Version Nothing c Nothing Nothing) + . Chunks + . NE.fromList + . fmap (Numeric . fromIntegral) . versionNumbers . pkgVersion . package diff --git a/lib/GHCup/Prelude/MegaParsec.hs b/lib/GHCup/Prelude/MegaParsec.hs index 2f8d06b..c28f011 100644 --- a/lib/GHCup/Prelude/MegaParsec.hs +++ b/lib/GHCup/Prelude/MegaParsec.hs @@ -91,18 +91,16 @@ ghcTargetVerP = verP' :: MP.Parsec Void Text Text verP' = do v <- version' - let startsWithDigists = + let startsWithDigits = and . take 3 - . concatMap - (map - (\case - (Digits _) -> True - (Str _) -> False - ) . NE.toList) + . map (\case + Numeric _ -> True + Alphanum _ -> False) . NE.toList + . (\(Chunks nec) -> nec) $ _vChunks v - if startsWithDigists && isNothing (_vEpoch v) + if startsWithDigits && isNothing (_vEpoch v) then pure $ prettyVer v else fail "Oh" diff --git a/lib/GHCup/Prelude/Version/QQ.hs b/lib/GHCup/Prelude/Version/QQ.hs index d3d03c6..04290ea 100644 --- a/lib/GHCup/Prelude/Version/QQ.hs +++ b/lib/GHCup/Prelude/Version/QQ.hs @@ -33,29 +33,9 @@ import qualified Data.Text as T 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) deriving instance Lift (NonEmpty Word) -deriving instance Lift (NonEmpty VChunk) deriving instance Lift (NonEmpty MChunk) -deriving instance Lift (NonEmpty VUnit) #endif qq :: (Text -> Q Exp) -> QuasiQuoter diff --git a/lib/GHCup/Types/JSON.hs b/lib/GHCup/Types/JSON.hs index 40bbb10..ed308ab 100644 --- a/lib/GHCup/Types/JSON.hs +++ b/lib/GHCup/Types/JSON.hs @@ -48,10 +48,11 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMo deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep -deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VUnit deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Mess +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Chunk +deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Release deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''SemVer deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Tool deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GlobalTool diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 16259b9..eb27f64 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -687,10 +687,8 @@ hlsAllBinaries ver = do -- | Extract (major, minor) from any version. getMajorMinorV :: MonadThrow m => Version -> m (Int, Int) -getMajorMinorV Version {..} = case _vChunks of - ((Digits x :| []) :| ((Digits y :| []):_)) -> pure (fromIntegral x, fromIntegral y) - _ -> throwM $ ParseError "Could not parse X.Y from version" - +getMajorMinorV (Version _ (Chunks (Numeric x :| Numeric y : _)) _ _) = pure (fromIntegral x, fromIntegral y) +getMajorMinorV _ = throwM $ ParseError "Could not parse X.Y from version" matchMajor :: Version -> Int -> Int -> Bool matchMajor v' major' minor' = case getMajorMinorV v' of diff --git a/lib/GHCup/Version.hs b/lib/GHCup/Version.hs index aeee2bc..18c32d1 100644 --- a/lib/GHCup/Version.hs +++ b/lib/GHCup/Version.hs @@ -24,10 +24,10 @@ import qualified Data.Text as T import qualified Data.Versions as V import Control.Exception.Safe (MonadThrow) import Data.Text (Text) -import Data.List.NonEmpty (NonEmpty((:|))) -import Data.List (intersperse) import Control.Monad.Catch (throwM) import GHCup.Errors (ParseError(..)) +import Text.Megaparsec +import Data.Void (Void) -- | 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 versionToPVP :: MonadThrow m => V.Version -> m (V.PVP, Text) 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 - alternative :: MonadThrow m => V.Version -> m V.PVP - alternative v' = case NE.takeWhile isDigit (V._vChunks v') of - [] -> throwM $ ParseError "Couldn't convert Version to PVP" - xs -> pure $ pvpFromList (unsafeDigit <$> xs) - - 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" + pvp'' :: Parsec Void T.Text (V.PVP, T.Text) + pvp'' = do + p <- V.pvp' + s <- getParserState + pure (p, stateInput s) pvpFromList :: [Int] -> V.PVP pvpFromList = V.PVP . NE.fromList . fmap fromIntegral diff --git a/stack.yaml b/stack.yaml index 7b7d145..57a2c11 100644 --- a/stack.yaml +++ b/stack.yaml @@ -24,6 +24,8 @@ extra-deps: - strict-base-0.4.0.0 - text-2.0.2 - yaml-streamly-0.12.2 + - github: fosskers/versions + commit: e08a188150f120c9b1c5bee8237beed6b1c568bc flags: http-io-streams: diff --git a/test/optparse-test/ChangeLogTest.hs b/test/optparse-test/ChangeLogTest.hs index 5179cad..d1b0f1d 100644 --- a/test/optparse-test/ChangeLogTest.hs +++ b/test/optparse-test/ChangeLogTest.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} + module ChangeLogTest where import Test.Tasty @@ -6,8 +9,6 @@ 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 @@ -30,7 +31,7 @@ checkList = (Just $ GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])) + $(verQ "9.2")) ) , ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended)) , ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended)) @@ -38,7 +39,7 @@ checkList = (Just $ GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []])) + $(verQ "3.10.1.0")) ) , ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22")))) ] diff --git a/test/optparse-test/CompileTest.hs b/test/optparse-test/CompileTest.hs index e246757..ff7beca 100644 --- a/test/optparse-test/CompileTest.hs +++ b/test/optparse-test/CompileTest.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} module CompileTest where @@ -59,12 +60,12 @@ 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") + (Left $(verQ "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") + (Left $(verQ "9.2.8")) ) , ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2", 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 (GHC.RemoteDist [uri|https://gitlab.haskell.org/ghc/ghc.git|]) - (Left $ mkVersion' "9.2.8") + (Left $(verQ "9.2.8")) ) , (baseCmd <> "-j20", baseOptions{GHC.jobs = Just 20}) , (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 <> "-- --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 <> "-o 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(verQ "9.4.5-p1")}) + , (baseCmd <> "--overwrite-version 9.4.5-p1", baseOptions{GHC.ovewrwiteVer = Just $(verQ "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}) @@ -107,8 +108,8 @@ compileGhcCheckList = mapSecond CompileGHC baseOptions :: GHCCompileOptions baseOptions = mkDefaultGHCCompileOptions - (GHC.SourceDist $ mkVersion' "9.4.5") - (Left $ mkVersion' "9.2.8") + (GHC.SourceDist $(verQ "9.4.5")) + (Left $(verQ "9.2.8")) compileHlsCheckList :: [(String, CompileCommand)] compileHlsCheckList = mapSecond CompileHLS @@ -136,7 +137,7 @@ compileHlsCheckList = mapSecond CompileHLS ) , ("compile hls --source-dist 2.0.0.0 --ghc 9.2.8", mkDefaultHLSCompileOptions - (HLS.SourceDist $ mkVersion' "2.0.0.0") + (HLS.SourceDist $(verQ "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", @@ -146,15 +147,15 @@ compileHlsCheckList = mapSecond CompileHLS ) , ("compile hls -v 2.0.0.0 --ghc latest", mkDefaultHLSCompileOptions - (HLS.HackageDist $ mkVersion' "2.0.0.0") + (HLS.HackageDist $(verQ "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 <> "-o 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(verQ "2.0.0.0-p1")}) + , (baseCmd <> "--overwrite-version 2.0.0.0-p1", baseOptions{HLS.ovewrwiteVer = Right $(verQ "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"}) @@ -178,11 +179,11 @@ compileHlsCheckList = mapSecond CompileHLS baseOptions :: HLSCompileOptions baseOptions = mkDefaultHLSCompileOptions - (HLS.HackageDist $ mkVersion' "2.0.0.0") + (HLS.HackageDist $(verQ "2.0.0.0")) [ghc928] ghc928 :: ToolVersion - ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8") + ghc928 = GHCVersion $ GHCTargetVersion Nothing $(verQ "9.2.8") compileParseWith :: [String] -> IO CompileCommand compileParseWith args = do diff --git a/test/optparse-test/InstallTest.hs b/test/optparse-test/InstallTest.hs index 8f13e42..c93994d 100644 --- a/test/optparse-test/InstallTest.hs +++ b/test/optparse-test/InstallTest.hs @@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} 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" , 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" :| []) :| []) + , instVer = Just $ GHCVersion $ GHCTargetVersion Nothing $(verQ "head") } ) : mapSecond @@ -62,48 +63,48 @@ oldStyleCheckList = [ ("install ghc-9.2", GHCVersion $ GHCTargetVersion (Just "ghc") - (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) + $(verQ "9.2") ) -- invalid , ("install next", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "next" :| []) :| []) + $(verQ "next") ) , ("install latest", ToolTag Latest) , ("install nightly", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "nightly" :| []) :| []) + $(verQ "nightly") ) , ("install recommended", ToolTag Recommended) , ("install prerelease", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "prerelease" :| []) :| []) + $(verQ "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 :| []]) + $(verQ "9.6") ) , ("install base-4.18", ToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("install cabal-3.10", GHCVersion $ GHCTargetVersion (Just "cabal") - (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) + $(verQ "3.10") ) , ("install hls-2.0.0.0", GHCVersion $ GHCTargetVersion (Just "hls") - (mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) + $(verQ "2.0.0.0") ) , ("install stack-2.9.3", GHCVersion $ GHCTargetVersion (Just "stack") - (mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) + $(verQ "2.9.3") ) ] @@ -114,37 +115,37 @@ installGhcCheckList = [ ("install ghc 9.2", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) + $(verQ "9.2") ) , ("install ghc next", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "next" :| []) :| []) + $(verQ "next") ) , ("install ghc latest", ToolTag Latest) , ("install ghc nightly", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "nightly" :| []) :| []) + $(verQ "nightly") ) , ("install ghc recommended", ToolTag Recommended) , ("install ghc prerelease", GHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "prerelease" :| []) :| []) + $(verQ "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 :| []]) + $(verQ "9.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 :| []]) + $(verQ "9.2") ) ] @@ -152,69 +153,48 @@ 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 3.10", ToolVersion $(verQ "3.10")) + , ("install cabal next", ToolVersion $(verQ "next")) , ("install cabal latest", ToolTag Latest) - , ("install cabal nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("install cabal nightly", ToolVersion $(verQ "nightly")) , ("install cabal recommended", ToolTag Recommended) - , ("install cabal prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("install cabal prerelease", ToolVersion $(verQ "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 - } - ) + , ("install cabal cabal-3.10", ToolVersion $(verQ "cabal-3.10")) ] 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 3.10", ToolVersion $(verQ "3.10")) + , ("install hls next", ToolVersion $(verQ "next")) , ("install hls latest", ToolTag Latest) - , ("install hls nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("install hls nightly", ToolVersion $(verQ "nightly")) , ("install hls recommended", ToolTag Recommended) - , ("install hls prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("install hls prerelease", ToolVersion $(verQ "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 - } - ) + , ("install hls hls-2.0", ToolVersion $(verQ "hls-2.0")) ] 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 3.10", ToolVersion $(verQ "3.10")) + , ("install stack next", ToolVersion $(verQ "next")) , ("install stack latest", ToolTag Latest) - , ("install stack nightly", ToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("install stack nightly", ToolVersion $(verQ "nightly")) , ("install stack recommended", ToolTag Recommended) - , ("install stack prerelease", ToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("install stack prerelease", ToolVersion $(verQ "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 - } - ) + , ("install stack stack-2.9", ToolVersion $(verQ "stack-2.9")) ] installParseWith :: [String] -> IO (Either InstallCommand InstallOptions) diff --git a/test/optparse-test/RmTest.hs b/test/optparse-test/RmTest.hs index 4ef25e2..fb70610 100644 --- a/test/optparse-test/RmTest.hs +++ b/test/optparse-test/RmTest.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module RmTest where @@ -24,54 +25,36 @@ rmTests = 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 :| []])) + ("rm 9.2.8", mkTVer $(verQ "9.2.8")) + , ("rm ghc-9.2.8", GHCTargetVersion (Just "ghc") $(verQ "9.2.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 :| []])) + ("rm ghc 9.2.8", mkTVer $(verQ "9.2.8")) + , ("rm ghc ghc-9.2.8", GHCTargetVersion (Just "ghc") $(verQ "9.2.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 - } - ) + ("rm cabal 3.10", $(verQ "3.10")) + , ("rm cabal cabal-3.10", $(verQ "cabal-3.10")) ] 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 - } - ) + ("rm hls 2.0", $(verQ "2.0")) + , ("rm hls hls-2.0", $(verQ "hls-2.0")) ] 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 - } - ) + ("rm stack 2.9.1", $(verQ "2.9.1")) + , ("rm stack stack-2.9.1", $(verQ "stack-2.9.1")) ] rmParseWith :: [String] -> IO (Either RmCommand RmOptions) diff --git a/test/optparse-test/RunTest.hs b/test/optparse-test/RunTest.hs index d5c4a94..d4416c2 100644 --- a/test/optparse-test/RunTest.hs +++ b/test/optparse-test/RunTest.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE TemplateHaskell #-} module RunTest where @@ -35,11 +36,11 @@ runCheckList = , ("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 9.2.8", defaultOptions{runGHCVer = Just $ GHCVersion $ mkTVer $(verQ "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"}) + , ("run --cabal 3.10", defaultOptions{runCabalVer = Just $ ToolVersion $(verQ "3.10")}) + , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(verQ "2.0")}) + , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(verQ "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"}) @@ -52,9 +53,9 @@ runCheckList = , ("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" + , runCabalVer = Just $ ToolVersion $(verQ "3.10") + , runHLSVer = Just $ ToolVersion $(verQ "2.0") + , runStackVer = Just $ ToolVersion $(verQ "2.9") , runInstTool' = True } ) diff --git a/test/optparse-test/SetTest.hs b/test/optparse-test/SetTest.hs index cb0cd63..7f0a0ec 100644 --- a/test/optparse-test/SetTest.hs +++ b/test/optparse-test/SetTest.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module SetTest where @@ -27,44 +28,44 @@ oldStyleCheckList = mapSecond (Right . SetOptions) , ("set ghc-9.2", SetGHCVersion $ GHCTargetVersion (Just "ghc") - (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) + $(verQ "9.2") ) , ("set next", SetNext) , ("set latest", SetToolTag Latest) , ("set nightly", SetGHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "nightly" :| []) :| []) + $(verQ "nightly") ) -- different from `set` , ("set recommended", SetToolTag Recommended) , ("set prerelease", SetGHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "prerelease" :| []) :| []) + $(verQ "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 :| []]) + $(verQ "9.6") ) , ("set base-4.18", SetToolTag (Base (PVP {_pComponents = 4 :| [18]}))) , ("set cabal-3.10", SetGHCVersion $ GHCTargetVersion (Just "cabal") - (mkVersion $ (Digits 3 :| []) :| [Digits 10 :| []]) + $(verQ "3.10") ) , ("set hls-2.0.0.0", SetGHCVersion $ GHCTargetVersion (Just "hls") - (mkVersion $ (Digits 2 :| []) :| [Digits 0 :| [], Digits 0 :| [], Digits 0 :| []]) + $(verQ "2.0.0.0") ) , ("set stack-2.9.3", SetGHCVersion $ GHCTargetVersion (Just "stack") - (mkVersion $ (Digits 2 :| []) :| [Digits 9 :| [], Digits 3 :| []]) + $(verQ "2.9.3") ) ] @@ -74,100 +75,79 @@ setGhcCheckList = mapSecond (Left . SetGHC . SetOptions) , ("set ghc 9.2", SetGHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]) + $(verQ "9.2") ) , ("set ghc next", SetNext) , ("set ghc latest", SetToolTag Latest) , ("set ghc nightly", SetGHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "nightly" :| []) :| []) + $(verQ "nightly") ) , ("set ghc recommended", SetToolTag Recommended) , ("set ghc prerelease", SetGHCVersion $ GHCTargetVersion Nothing - (mkVersion $ (Str "prerelease" :| []) :| []) + $(verQ "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 :| []]) + $(verQ "9.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 :| []]) + $(verQ "9.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 3.10", SetToolVersion $(verQ "3.10")) , ("set cabal next", SetNext) , ("set cabal latest", SetToolTag Latest) - , ("set cabal nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("set cabal nightly", SetToolVersion $(verQ "nightly")) , ("set cabal recommended", SetToolTag Recommended) - , ("set cabal prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("set cabal prerelease", SetToolVersion $(verQ "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 - } - ) + , ("set cabal cabal-3.10", SetToolVersion $(verQ "cabal-3.10")) ] 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 2.0", SetToolVersion $(verQ "2.0")) , ("set hls next", SetNext) , ("set hls latest", SetToolTag Latest) - , ("set hls nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("set hls nightly", SetToolVersion $(verQ "nightly")) , ("set hls recommended", SetToolTag Recommended) - , ("set hls prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("set hls prerelease", SetToolVersion $(verQ "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 - } - ) + , ("set hls hls-2.0", SetToolVersion $(verQ "hls-2.0")) ] 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 2.9", SetToolVersion $(verQ "2.9")) , ("set stack next", SetNext) , ("set stack latest", SetToolTag Latest) - , ("set stack nightly", SetToolVersion $ mkVersion $ (Str "nightly" :| []) :| []) + , ("set stack nightly", SetToolVersion $(verQ "nightly")) , ("set stack recommended", SetToolTag Recommended) - , ("set stack prerelease", SetToolVersion $ mkVersion $ (Str "prerelease" :| []) :| []) + , ("set stack prerelease", SetToolVersion $(verQ "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 - } - ) + , ("set stack stack-2.9", SetToolVersion $(verQ "stack-2.9")) ] setParseWith :: [String] -> IO (Either SetCommand SetOptions) diff --git a/test/optparse-test/Utils.hs b/test/optparse-test/Utils.hs index 2c99166..7ee17f2 100644 --- a/test/optparse-test/Utils.hs +++ b/test/optparse-test/Utils.hs @@ -10,6 +10,8 @@ import Test.Tasty import Test.Tasty.HUnit import Control.Monad.IO.Class import qualified Data.Text as T +import Language.Haskell.TH (Exp, Q) +import Language.Haskell.TH.Syntax (lift) parseWith :: [String] -> IO Command parseWith args = @@ -23,13 +25,12 @@ padLeft desiredLength s = padding ++ 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 +-- | Parse a `Version` at compile time. +verQ :: T.Text -> Q Exp +verQ nm = + case version nm of + Left err -> fail (errorBundlePretty err) + Right v -> lift v buildTestTree :: (Eq a, Show a) diff --git a/test/optparse-test/WhereisTest.hs b/test/optparse-test/WhereisTest.hs index 92fe79f..ca27593 100644 --- a/test/optparse-test/WhereisTest.hs +++ b/test/optparse-test/WhereisTest.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module WhereisTest where @@ -13,8 +14,8 @@ 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 9.2.8", WhereisTool GHC (Just $ GHCVersion $ mkTVer $(verQ "9.2.8"))) + , ("whereis ghc ghc-9.2.8", WhereisTool GHC (Just $ GHCVersion $ GHCTargetVersion (Just "ghc") $(verQ "9.2.8"))) , ("whereis ghc latest", WhereisTool GHC (Just $ ToolTag Latest)) , ("whereis cabal", WhereisTool Cabal Nothing) , ("whereis hls", WhereisTool HLS Nothing)