Automated instruction testing using linked repo

https://github.com/adtennant/GameboyCPUTests

1 files changed, 42 insertions, 8 deletions

diff --git a/fig-emulator-gb/main/Main.hs b/fig-emulator-gb/main/Main.hs
index 552f2ed..8cb61d0 100644
--- a/fig-emulator-gb/main/Main.hs
+++ b/fig-emulator-gb/main/Main.hs
@@ -6,24 +6,58 @@ import Fig.Prelude
 
 import Options.Applicative
 
+import Control.Exception.Safe (Handler(..), catches)
+
 import qualified Data.ByteString as BS
 
 import Fig.Emulator.GB
+import Fig.Emulator.GB.Test.Instr
 
-newtype Options = Options
-  { romPath :: FilePath
+data RunOptions = RunOptions
+  { romPath :: !FilePath
+  , serialOut :: !FilePath
   } deriving Show
 
-parseOptions :: Parser Options
-parseOptions = do
+parseRunOptions :: Parser RunOptions
+parseRunOptions = do
   romPath <- argument str (metavar "PATH")
-  pure Options{..}
+  serialOut <- strOption (long "serial" <> metavar "PATH" <> help "Path to write link cable serial output")
+  pure RunOptions{..}
+
+newtype InstrTestOptions = InstrTestOptions
+  { testcasesPath :: FilePath
+  } deriving Show
+
+parseInstrTestOptions :: Parser InstrTestOptions
+parseInstrTestOptions = do
+  testcasesPath <- argument str (metavar "PATH")
+  pure InstrTestOptions{..}
+
+data Command
+  = CommandRun RunOptions
+  | CommandInstrTest InstrTestOptions
+  deriving Show
+
+parseOptions :: Parser Command
+parseOptions = subparser $ mconcat
+  [ command "run" $ info (CommandRun <$> parseRunOptions) (progDesc "Emulate a ROM file")
+  , command "instr-test" $ info (CommandInstrTest <$> parseInstrTestOptions) (progDesc "Run CPU testcases")
+  ]
 
 main :: IO ()
 main = do
-  opts <- execParser $ info (parseOptions <**> helper)
+  cmd <- execParser $ info (parseOptions <**> helper)
     ( fullDesc
     <> header "fig-emulator-gb - Game Boy emulator"
     )
-  rom <- BS.readFile $ romPath opts
-  testRun rom
+  case cmd of
+    CommandRun opts -> do
+      rom <- BS.readFile $ romPath opts
+      testRun (serialOut opts) rom
+    CommandInstrTest opts -> catches
+      ( do
+          tcs <- readTestcases $ testcasesPath opts
+          forM_ tcs runTestcase
+      )
+      [ Handler \(e :: InstrTestError) -> liftIO . hPutStrLn stderr $ pretty e
+      ]