hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

refactor: upgrade versions library usage

Browse Source
This commit is contained in:
Colin Woodbury 2023-10-13 17:09:35 +09:00 committed by Julian Ospald
parent fbb648d984
commit 15c6ed2b8d
No known key found for this signature in database
GPG Key ID: 4275CDA6A29BED43
16 changed files with 135 additions and 234 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
ghcup.cabal
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 >=4.0.1 && <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 >=4.0.1 && <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 >=4.0.1 && <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

6
lib/GHCup/HLS.hs
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

14
lib/GHCup/Prelude/MegaParsec.hs
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"

20
lib/GHCup/Prelude/Version/QQ.hs
View File

@ -33,29 +33,9 @@ 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

3
lib/GHCup/Types/JSON.hs
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

6
lib/GHCup/Utils.hs
View File

@ -694,10 +694,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

49
lib/GHCup/Version.hs
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

2
stack.yaml
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: e08a188150f120c9b1c5bee8237beed6b1c568bc
flags: flags:
http-io-streams: http-io-streams:

9
test/optparse-test/ChangeLogTest.hs
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,6 @@ 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.List.NonEmpty (NonEmpty ((:|)))
changeLogTests :: TestTree changeLogTests :: TestTree
changeLogTests = testGroup "changelog" $ map (uncurry check) checkList changeLogTests = testGroup "changelog" $ map (uncurry check) checkList
@ -30,7 +31,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []])) $(verQ "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 +39,7 @@ checkList =
(Just $ GHCVersion (Just $ GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing 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")))) , ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
] ]

27
test/optparse-test/CompileTest.hs
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 $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "9.4.5"))
(Left $ mkVersion' "9.2.8") (Left $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "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 $(verQ "2.0.0.0"))
[ghc928] [ghc928]
ghc928 :: ToolVersion ghc928 :: ToolVersion
ghc928 = GHCVersion $ GHCTargetVersion Nothing (mkVersion' "9.2.8") ghc928 = GHCVersion $ GHCTargetVersion Nothing $(verQ "9.2.8")
compileParseWith :: [String] -> IO CompileCommand compileParseWith :: [String] -> IO CompileCommand
compileParseWith args = do compileParseWith args = do

82
test/optparse-test/InstallTest.hs
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 $(verQ "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 :| []]) $(verQ "9.2")
) )
-- invalid -- invalid
, ("install next", GHCVersion , ("install next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(verQ "next")
) )
, ("install latest", ToolTag Latest) , ("install latest", ToolTag Latest)
, ("install nightly", GHCVersion , ("install nightly", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "nightly" :| []) :| []) $(verQ "nightly")
) )
, ("install recommended", ToolTag Recommended) , ("install recommended", ToolTag Recommended)
, ("install prerelease", GHCVersion , ("install prerelease", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "prerelease" :| []) :| []) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "9.2")
) )
, ("install ghc next", GHCVersion , ("install ghc next", GHCVersion
$ GHCTargetVersion $ GHCTargetVersion
Nothing Nothing
(mkVersion $ (Str "next" :| []) :| []) $(verQ "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" :| []) :| []) $(verQ "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" :| []) :| []) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 $(verQ "3.10"))
, ("install cabal next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install cabal next", ToolVersion $(verQ "next"))
, ("install cabal latest", ToolTag Latest) , ("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 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-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 $(verQ "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 $(verQ "3.10"))
, ("install hls next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install hls next", ToolVersion $(verQ "next"))
, ("install hls latest", ToolTag Latest) , ("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 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-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 $(verQ "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 $(verQ "3.10"))
, ("install stack next", ToolVersion $ mkVersion $ (Str "next" :| []) :| []) , ("install stack next", ToolVersion $(verQ "next"))
, ("install stack latest", ToolTag Latest) , ("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 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-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 $(verQ "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)

39
test/optparse-test/RmTest.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module RmTest where module RmTest where
@ -24,54 +25,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 $(verQ "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") $(verQ "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 $(verQ "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") $(verQ "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", $(verQ "3.10"))
, ("rm cabal cabal-3.10", Version , ("rm cabal cabal-3.10", $(verQ "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", $(verQ "2.0"))
, ("rm hls hls-2.0", Version , ("rm hls hls-2.0", $(verQ "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", $(verQ "2.9.1"))
, ("rm stack stack-2.9.1", Version , ("rm stack stack-2.9.1", $(verQ "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)

15
test/optparse-test/RunTest.hs
View File

@ -1,5 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module RunTest where module RunTest where
@ -35,11 +36,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 $(verQ "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 $(verQ "3.10")})
, ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $ mkVersion' "2.0"}) , ("run --hls 2.0", defaultOptions{runHLSVer = Just $ ToolVersion $(verQ "2.0")})
, ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $ mkVersion' "2.9"}) , ("run --stack 2.9", defaultOptions{runStackVer = Just $ ToolVersion $(verQ "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 +53,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 $(verQ "3.10")
, runHLSVer = Just $ ToolVersion $ mkVersion' "2.0" , runHLSVer = Just $ ToolVersion $(verQ "2.0")
, runStackVer = Just $ ToolVersion $ mkVersion' "2.9" , runStackVer = Just $ ToolVersion $(verQ "2.9")
, runInstTool' = True , runInstTool' = True
} }
) )

70
test/optparse-test/SetTest.hs
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 :| []]) $(verQ "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" :| []) :| []) $(verQ "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" :| []) :| []) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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" :| []) :| []) $(verQ "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" :| []) :| []) $(verQ "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 :| []]) $(verQ "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 :| []]) $(verQ "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 $(verQ "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 $(verQ "nightly"))
, ("set cabal recommended", SetToolTag Recommended) , ("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-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 $(verQ "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 $(verQ "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 $(verQ "nightly"))
, ("set hls recommended", SetToolTag Recommended) , ("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-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 $(verQ "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 $(verQ "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 $(verQ "nightly"))
, ("set stack recommended", SetToolTag Recommended) , ("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-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 $(verQ "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)

15
test/optparse-test/Utils.hs
View File

@ -10,6 +10,8 @@ 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 import qualified Data.Text as T
import Language.Haskell.TH (Exp, Q)
import Language.Haskell.TH.Syntax (lift)
parseWith :: [String] -> IO Command parseWith :: [String] -> IO Command
parseWith args = parseWith args =
@ -23,13 +25,12 @@ 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 -- | Parse a `Version` at compile time.
mkVersion chunks = Version Nothing chunks [] Nothing verQ :: T.Text -> Q Exp
verQ nm =
mkVersion' :: T.Text -> Version case version nm of
mkVersion' txt = Left err -> fail (errorBundlePretty err)
let Right ver = version txt Right v -> lift v
in ver
buildTestTree buildTestTree
:: (Eq a, Show a) :: (Eq a, Show a)

5
test/optparse-test/WhereisTest.hs
View File

@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
module WhereisTest where module WhereisTest where
@ -13,8 +14,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 $(verQ "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") $(verQ "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)