debug-info test
This commit is contained in:
		
							parent
							
								
									83b82c328b
								
							
						
					
					
						commit
						bcdf2b23f1
					
				@ -417,6 +417,8 @@ test-suite ghcup-optparse-test
 | 
				
			|||||||
  main-is: Main.hs
 | 
					  main-is: Main.hs
 | 
				
			||||||
  other-modules:
 | 
					  other-modules:
 | 
				
			||||||
    SetTest
 | 
					    SetTest
 | 
				
			||||||
 | 
					    Utils
 | 
				
			||||||
 | 
					    DebugInfoTest
 | 
				
			||||||
  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
 | 
				
			||||||
							
								
								
									
										18
									
								
								test/optparse-test/DebugInfoTest.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										18
									
								
								test/optparse-test/DebugInfoTest.hs
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,18 @@
 | 
				
			|||||||
 | 
					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,6 +1,10 @@
 | 
				
			|||||||
module Main where
 | 
					module Main where
 | 
				
			||||||
import Test.Tasty
 | 
					import Test.Tasty
 | 
				
			||||||
import qualified SetTest
 | 
					import qualified SetTest
 | 
				
			||||||
 | 
					import qualified DebugInfoTest
 | 
				
			||||||
 | 
					
 | 
				
			||||||
main :: IO ()
 | 
					main :: IO ()
 | 
				
			||||||
main = defaultMain SetTest.setTests
 | 
					main = defaultMain $ testGroup "ghcup"
 | 
				
			||||||
 | 
					  [ SetTest.setTests
 | 
				
			||||||
 | 
					  , DebugInfoTest.debugInfoTests
 | 
				
			||||||
 | 
					  ]
 | 
				
			||||||
@ -5,12 +5,11 @@ module SetTest where
 | 
				
			|||||||
import GHCup.OptParse as GHCup
 | 
					import GHCup.OptParse as GHCup
 | 
				
			||||||
import Test.Tasty
 | 
					import Test.Tasty
 | 
				
			||||||
import Test.Tasty.HUnit
 | 
					import Test.Tasty.HUnit
 | 
				
			||||||
import Options.Applicative
 | 
					 | 
				
			||||||
import Control.Monad.IO.Class (liftIO)
 | 
					import Control.Monad.IO.Class (liftIO)
 | 
				
			||||||
import GHCup.Types
 | 
					import GHCup.Types
 | 
				
			||||||
import Data.Versions
 | 
					import Data.Versions
 | 
				
			||||||
import Data.List.NonEmpty (NonEmpty ((:|)))
 | 
					import Data.List.NonEmpty (NonEmpty ((:|)))
 | 
				
			||||||
import Data.Bifunctor (second)
 | 
					import Utils
 | 
				
			||||||
 | 
					
 | 
				
			||||||
setTests :: TestTree
 | 
					setTests :: TestTree
 | 
				
			||||||
setTests =
 | 
					setTests =
 | 
				
			||||||
@ -190,15 +189,3 @@ setParseWith :: [String] -> IO (Either SetCommand SetOptions)
 | 
				
			|||||||
setParseWith args = do
 | 
					setParseWith args = do
 | 
				
			||||||
  Set a <- parseWith args
 | 
					  Set a <- parseWith args
 | 
				
			||||||
  pure a
 | 
					  pure a
 | 
				
			||||||
 | 
					 | 
				
			||||||
parseWith :: [String] -> IO Command
 | 
					 | 
				
			||||||
parseWith args =
 | 
					 | 
				
			||||||
  optCommand <$> handleParseResult
 | 
					 | 
				
			||||||
    (execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
padLeft :: Int -> String -> String
 | 
					 | 
				
			||||||
padLeft desiredLength s = padding ++ s
 | 
					 | 
				
			||||||
  where padding = replicate (desiredLength - length s) ' '
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
 | 
					 | 
				
			||||||
mapSecond = map . second
 | 
					 | 
				
			||||||
 | 
				
			|||||||
							
								
								
									
										17
									
								
								test/optparse-test/Utils.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										17
									
								
								test/optparse-test/Utils.hs
									
									
									
									
									
										Normal file
									
								
							@ -0,0 +1,17 @@
 | 
				
			|||||||
 | 
					module Utils where
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					import GHCup.OptParse as GHCup
 | 
				
			||||||
 | 
					import Options.Applicative
 | 
				
			||||||
 | 
					import Data.Bifunctor
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					parseWith :: [String] -> IO Command
 | 
				
			||||||
 | 
					parseWith args =
 | 
				
			||||||
 | 
					  optCommand <$> handleParseResult
 | 
				
			||||||
 | 
					    (execParserPure defaultPrefs (info GHCup.opts fullDesc) args)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					padLeft :: Int -> String -> String
 | 
				
			||||||
 | 
					padLeft desiredLength s = padding ++ s
 | 
				
			||||||
 | 
					  where padding = replicate (desiredLength - length s) ' '
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					mapSecond :: (b -> c) -> [(a,b)] -> [(a,c)]
 | 
				
			||||||
 | 
					mapSecond = map . second
 | 
				
			||||||
		Loading…
	
		Reference in New Issue
	
	Block a user