compile test

app/ghcup/GHCup/OptParse/Compile.hs

@@ -57,6 +57,7 @@ import Text.Read (readEither)
 
 data CompileCommand = CompileGHC GHCCompileOptions
                     | CompileHLS HLSCompileOptions
+                    deriving (Eq, Show)
 
 
 
@@ -78,7 +79,7 @@ data GHCCompileOptions = GHCCompileOptions
   , buildFlavour :: Maybe String
   , hadrian      :: Bool
   , isolateDir   :: Maybe FilePath
-  }
+  } deriving (Eq, Show)
 
 
 data HLSCompileOptions = HLSCompileOptions
@@ -93,7 +94,7 @@ data HLSCompileOptions = HLSCompileOptions
   , patches      :: Maybe (Either FilePath [URI])
   , targetGHCs   :: [ToolVersion]
   , cabalArgs    :: [Text]
-  }
+  } deriving (Eq, Show)
 
 
 

ghcup.cabal

@@ -426,6 +426,7 @@ test-suite ghcup-optparse-test
     RmTest
     ListTest
     UpgradeTest
+    CompileTest
   default-language: Haskell2010
   ghc-options: -Wall
   build-depends: base, ghcup, ghcup-optparse, tasty, tasty-hunit, optparse-applicative, versions, text, uri-bytestring

lib/GHCup/GHC.hs

@@ -83,6 +83,7 @@ import qualified Text.Megaparsec               as MP
 data GHCVer = SourceDist Version
             | GitDist GitBranch
             | RemoteDist URI
+            deriving (Eq, Show)
 
 
 

lib/GHCup/HLS.hs

@@ -75,6 +75,7 @@ data HLSVer = SourceDist Version
             | GitDist GitBranch
             | HackageDist Version
             | RemoteDist URI
+            deriving (Eq, Show)
 
 
 

test/optparse-test/CompileTest.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module CompileTest where
+
+import Test.Tasty
+import GHCup.OptParse
+import Utils
+import GHCup.GHC
+import Data.Versions
+import GHCup.Types
+
+
+compileTests :: TestTree
+compileTests = testGroup "compile"
+  $ map (buildTestTree compileParseWith)
+      [ ("ghc", compileGhcCheckList)
+      , ("hls", compileHlsCheckList)
+      ]
+
+mkDefaultGHCCompileOptions :: GHCVer -> Either Version FilePath -> GHCCompileOptions
+mkDefaultGHCCompileOptions target boot =
+  GHCCompileOptions
+    target
+    boot
+    Nothing
+    Nothing
+    (Just $ Right [])
+    Nothing
+    []
+    False
+    Nothing
+    Nothing
+    False
+    Nothing
+
+compileGhcCheckList :: [(String, CompileCommand)]
+compileGhcCheckList = mapSecond CompileGHC
+  [ ("compile ghc -v 9.4.5 -b 9.2.8", mkDefaultGHCCompileOptions
+        (SourceDist $ mkVersion' "9.4.5")
+        (Left $ mkVersion' "9.2.8")
+    )
+  , ("compile ghc -g a32db0b -b 9.2.8", mkDefaultGHCCompileOptions
+        (GitDist $ GitBranch "a32db0b" Nothing)
+        (Left $ mkVersion' "9.2.8")
+    )
+  , ("compile ghc -g a32db0b -b 9.2.8 -r https://gitlab.haskell.org/ghc/ghc.git",
+        mkDefaultGHCCompileOptions
+          (GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
+          (Left $ mkVersion' "9.2.8")
+    )
+  , ("compile ghc -g a32db0b -r https://gitlab.haskell.org/ghc/ghc.git -b /usr/bin/ghc-9.2.2",
+        mkDefaultGHCCompileOptions
+          (GitDist $ GitBranch "a32db0b" (Just "https://gitlab.haskell.org/ghc/ghc.git"))
+          (Right "/usr/bin/ghc-9.2.2")
+    )
+  ]
+
+compileHlsCheckList :: [(String, CompileCommand)]
+compileHlsCheckList = []
+
+compileParseWith :: [String] -> IO CompileCommand
+compileParseWith args = do
+  Compile a <- parseWith args
+  pure a

test/optparse-test/Main.hs

@@ -10,6 +10,7 @@ import qualified UnsetTest
 import qualified RmTest
 import qualified ListTest
 import qualified UpgradeTest
+import qualified CompileTest
 
 main :: IO ()
 main = defaultMain $ testGroup "ghcup"
@@ -22,4 +23,5 @@ main = defaultMain $ testGroup "ghcup"
   , RmTest.rmTests
   , ListTest.listTests
   , UpgradeTest.upgradeTests
+  , CompileTest.compileTests
   ]

test/optparse-test/Utils.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 module Utils where
 
 import GHCup.OptParse as GHCup
@@ -8,6 +9,7 @@ import Data.List.NonEmpty (NonEmpty)
 import Test.Tasty
 import Test.Tasty.HUnit
 import Control.Monad.IO.Class
+import qualified Data.Text as T
 
 parseWith :: [String] -> IO Command
 parseWith args =
@@ -24,6 +26,11 @@ 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
+
 buildTestTree
   :: (Eq a, Show a)
   => ([String] -> IO a) -- ^ The parse function