blob: 7a15c458faac1549dbf6355ff146acccd8c7e2c6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
|
{-# Language ApplicativeDo #-}
module Main where
import Fig.Prelude
import qualified System.Directory as Dir
import Options.Applicative
import Control.Monad (unless)
import Control.Exception.Safe (Handler(..), catches)
import qualified Data.ByteString as BS
import Fig.Emulator.GB
import Fig.Emulator.GB.Test.Instr
data RunOptions = RunOptions
{ romPath :: !FilePath
, serialOut :: !FilePath
} deriving Show
parseRunOptions :: Parser RunOptions
parseRunOptions = do
romPath <- argument str (metavar "PATH")
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
cmd <- execParser $ info (parseOptions <**> helper)
( fullDesc
<> header "fig-emulator-gb - Game Boy emulator"
)
case cmd of
CommandRun opts -> do
rom <- BS.readFile $ romPath opts
testRun (serialOut opts) rom
CommandInstrTest opts -> catches
( do
paths <- Dir.listDirectory $ testcasesPath opts
forM_ paths \p -> do
unless (p == "README.md") do
hPutStrLn stderr $ "Running test file: " <> pack p <> "..."
tcs <- readTestcases $ testcasesPath opts <> "/" <> p
forM_ tcs runTestcase
)
[ Handler \(e :: InstrTestError) -> liftIO . hPutStrLn stderr $ pretty e
]
|
