changlog test
This commit is contained in:
parent
bcdf2b23f1
commit
38db038953
11
.editorconfig
Normal file
11
.editorconfig
Normal file
@ -0,0 +1,11 @@
|
|||||||
|
root = true
|
||||||
|
|
||||||
|
[*]
|
||||||
|
end_of_line = LF
|
||||||
|
trim_trailing_whitespace = true
|
||||||
|
insert_final_newline = true
|
||||||
|
|
||||||
|
[*.hs]
|
||||||
|
indent_style = space
|
||||||
|
indent_size = 2
|
||||||
|
max_line_length = 80
|
@ -49,7 +49,7 @@ data ChangeLogOptions = ChangeLogOptions
|
|||||||
{ clOpen :: Bool
|
{ clOpen :: Bool
|
||||||
, clTool :: Maybe Tool
|
, clTool :: Maybe Tool
|
||||||
, clToolVer :: Maybe ToolVersion
|
, clToolVer :: Maybe ToolVersion
|
||||||
}
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -418,7 +418,8 @@ test-suite ghcup-optparse-test
|
|||||||
other-modules:
|
other-modules:
|
||||||
SetTest
|
SetTest
|
||||||
Utils
|
Utils
|
||||||
DebugInfoTest
|
OtherCommandTest
|
||||||
|
ChangeLogTest
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
@ -710,6 +710,7 @@ data ToolVersion = GHCVersion GHCTargetVersion
|
|||||||
| ToolVersion Version
|
| ToolVersion Version
|
||||||
| ToolTag Tag
|
| ToolTag Tag
|
||||||
| ToolDay Day
|
| ToolDay Day
|
||||||
|
deriving (Eq, Show)
|
||||||
|
|
||||||
instance Pretty ToolVersion where
|
instance Pretty ToolVersion where
|
||||||
pPrint (GHCVersion v) = pPrint v
|
pPrint (GHCVersion v) = pPrint v
|
||||||
|
49
test/optparse-test/ChangeLogTest.hs
Normal file
49
test/optparse-test/ChangeLogTest.hs
Normal file
@ -0,0 +1,49 @@
|
|||||||
|
module ChangeLogTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import GHCup.OptParse
|
||||||
|
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
|
||||||
|
where
|
||||||
|
check :: String -> ChangeLogOptions -> TestTree
|
||||||
|
check args expected = testCase args $ do
|
||||||
|
res <- changeLogParseWith (words args)
|
||||||
|
liftIO $ res @?= expected
|
||||||
|
|
||||||
|
checkList :: [(String, ChangeLogOptions)]
|
||||||
|
checkList =
|
||||||
|
[ ("changelog", ChangeLogOptions False Nothing Nothing)
|
||||||
|
, ("changelog -o", ChangeLogOptions True Nothing Nothing)
|
||||||
|
, ("changelog -t ghc", ChangeLogOptions False (Just GHC) Nothing)
|
||||||
|
, ("changelog -t cabal", ChangeLogOptions False (Just Cabal) Nothing)
|
||||||
|
, ("changelog -t hls", ChangeLogOptions False (Just HLS) Nothing)
|
||||||
|
, ("changelog -t stack", ChangeLogOptions False (Just Stack) Nothing)
|
||||||
|
, ("changelog -t ghcup", ChangeLogOptions False (Just GHCup) Nothing)
|
||||||
|
, ("changelog 9.2", ChangeLogOptions False Nothing
|
||||||
|
(Just $ GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Digits 9 :| []) :| [Digits 2 :| []]))
|
||||||
|
)
|
||||||
|
, ("changelog recommended", ChangeLogOptions False Nothing (Just $ ToolTag Recommended))
|
||||||
|
, ("changelog -t cabal recommended", ChangeLogOptions False (Just Cabal) (Just $ ToolTag Recommended))
|
||||||
|
, ("changelog -t cabal 3.10.1.0", ChangeLogOptions False (Just Cabal)
|
||||||
|
(Just $ GHCVersion
|
||||||
|
$ GHCTargetVersion
|
||||||
|
Nothing
|
||||||
|
(mkVersion $ (Digits 3 :| []) :| [Digits 10 :| [],Digits 1 :| [],Digits 0 :| []]))
|
||||||
|
)
|
||||||
|
, ("changelog 2023-07-22", ChangeLogOptions False Nothing (Just (ToolDay (read "2023-07-22"))))
|
||||||
|
]
|
||||||
|
|
||||||
|
changeLogParseWith :: [String] -> IO ChangeLogOptions
|
||||||
|
changeLogParseWith args = do
|
||||||
|
ChangeLog a <- parseWith args
|
||||||
|
pure a
|
@ -1,18 +0,0 @@
|
|||||||
module DebugInfoTest where
|
|
||||||
|
|
||||||
import Test.Tasty
|
|
||||||
import Test.Tasty.HUnit
|
|
||||||
import GHCup.OptParse
|
|
||||||
import Utils
|
|
||||||
import Control.Monad.IO.Class
|
|
||||||
|
|
||||||
debugInfoTests :: TestTree
|
|
||||||
debugInfoTests =
|
|
||||||
testGroup "debug-info" $ pure
|
|
||||||
$ testCase "1. debug-info" $ do
|
|
||||||
res <- parseWith ["debug-info"]
|
|
||||||
liftIO $ assertBool "debug-info parse failed" (isDInfo res)
|
|
||||||
where
|
|
||||||
isDInfo :: Command -> Bool
|
|
||||||
isDInfo DInfo = True
|
|
||||||
isDInfo _ = False
|
|
@ -1,10 +1,12 @@
|
|||||||
module Main where
|
module Main where
|
||||||
import Test.Tasty
|
import Test.Tasty
|
||||||
import qualified SetTest
|
import qualified SetTest
|
||||||
import qualified DebugInfoTest
|
import qualified OtherCommandTest
|
||||||
|
import qualified ChangeLogTest
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultMain $ testGroup "ghcup"
|
main = defaultMain $ testGroup "ghcup"
|
||||||
[ SetTest.setTests
|
[ SetTest.setTests
|
||||||
, DebugInfoTest.debugInfoTests
|
, OtherCommandTest.otherCommandTests
|
||||||
|
, ChangeLogTest.changeLogTests
|
||||||
]
|
]
|
24
test/optparse-test/OtherCommandTest.hs
Normal file
24
test/optparse-test/OtherCommandTest.hs
Normal file
@ -0,0 +1,24 @@
|
|||||||
|
module OtherCommandTest where
|
||||||
|
|
||||||
|
import Test.Tasty
|
||||||
|
import Test.Tasty.HUnit
|
||||||
|
import GHCup.OptParse
|
||||||
|
import Utils
|
||||||
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
|
otherCommandTests :: TestTree
|
||||||
|
otherCommandTests = testGroup "other command"
|
||||||
|
[ testCase "debug-info" $ do
|
||||||
|
res <- parseWith ["debug-info"]
|
||||||
|
liftIO $ assertBool "debug-info parse failed" (isDInfo res)
|
||||||
|
, testCase "tool-requirements" $ do
|
||||||
|
ToolRequirements opt <- parseWith ["tool-requirements"]
|
||||||
|
liftIO $ tlrRaw opt @?= False
|
||||||
|
, testCase "tool-requirements -r" $ do
|
||||||
|
ToolRequirements opt <- parseWith ["tool-requirements", "--raw-format"]
|
||||||
|
liftIO $ tlrRaw opt @?= True
|
||||||
|
]
|
||||||
|
|
||||||
|
isDInfo :: Command -> Bool
|
||||||
|
isDInfo DInfo = True
|
||||||
|
isDInfo _ = False
|
@ -33,9 +33,6 @@ setTests =
|
|||||||
res <- setParseWith (words args)
|
res <- setParseWith (words args)
|
||||||
liftIO $ res @?= expected
|
liftIO $ res @?= expected
|
||||||
|
|
||||||
mkVersion :: NonEmpty VChunk -> Version
|
|
||||||
mkVersion chunks = Version Nothing chunks [] Nothing
|
|
||||||
|
|
||||||
oldStyleCheckList :: [(String, Either SetCommand SetOptions)]
|
oldStyleCheckList :: [(String, Either SetCommand SetOptions)]
|
||||||
oldStyleCheckList = mapSecond (Right . SetOptions)
|
oldStyleCheckList = mapSecond (Right . SetOptions)
|
||||||
[ ("set", SetRecommended)
|
[ ("set", SetRecommended)
|
||||||
|
@ -3,6 +3,8 @@ 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)
|
||||||
|
|
||||||
parseWith :: [String] -> IO Command
|
parseWith :: [String] -> IO Command
|
||||||
parseWith args =
|
parseWith args =
|
||||||
@ -15,3 +17,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
|
||||||
|
Loading…
Reference in New Issue
Block a user