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
|
||||
, clTool :: Maybe Tool
|
||||
, clToolVer :: Maybe ToolVersion
|
||||
}
|
||||
} deriving (Eq, Show)
|
||||
|
||||
|
||||
|
||||
|
@ -418,7 +418,8 @@ test-suite ghcup-optparse-test
|
||||
other-modules:
|
||||
SetTest
|
||||
Utils
|
||||
DebugInfoTest
|
||||
OtherCommandTest
|
||||
ChangeLogTest
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text
|
@ -710,6 +710,7 @@ data ToolVersion = GHCVersion GHCTargetVersion
|
||||
| ToolVersion Version
|
||||
| ToolTag Tag
|
||||
| ToolDay Day
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Pretty ToolVersion where
|
||||
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
|
||||
import Test.Tasty
|
||||
import qualified SetTest
|
||||
import qualified DebugInfoTest
|
||||
import qualified OtherCommandTest
|
||||
import qualified ChangeLogTest
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain $ testGroup "ghcup"
|
||||
[ 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)
|
||||
liftIO $ res @?= expected
|
||||
|
||||
mkVersion :: NonEmpty VChunk -> Version
|
||||
mkVersion chunks = Version Nothing chunks [] Nothing
|
||||
|
||||
oldStyleCheckList :: [(String, Either SetCommand SetOptions)]
|
||||
oldStyleCheckList = mapSecond (Right . SetOptions)
|
||||
[ ("set", SetRecommended)
|
||||
|
@ -3,6 +3,8 @@ module Utils where
|
||||
import GHCup.OptParse as GHCup
|
||||
import Options.Applicative
|
||||
import Data.Bifunctor
|
||||
import Data.Versions
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
|
||||
parseWith :: [String] -> IO Command
|
||||
parseWith args =
|
||||
@ -15,3 +17,6 @@ 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
|
||||
|
Loading…
Reference in New Issue
Block a user