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
|
module Fig.Emulator.GB.Bus
( Addr(..)
, Component(..)
, Bus(..)
, update
, write
, read
) where
import Fig.Prelude
import Numeric (showHex)
import qualified Data.List as List
import Data.Word (Word16, Word8)
newtype Addr = Addr { unAddr :: Word16 }
deriving (Show, Num, Eq, Ord)
instance Pretty Addr where
pretty (Addr w) = "$" <> pack (showHex w "")
data Component m = forall (s :: Type). Component
{ compState :: !s
, compMatches :: !(Addr -> Bool)
, compUpdate :: !(s -> m s)
, compWrite :: !(s -> Addr -> Word8 -> m s)
, compRead :: !(s -> Addr -> m Word8)
}
newtype Bus m = Bus { busComponents :: [Component m] }
update :: forall m. MonadIO m => Bus m -> m (Bus m)
update b = Bus <$> forM (busComponents b) \Component{..} -> do
s <- compUpdate compState
pure Component { compState = s, ..}
write :: forall m. MonadIO m => Bus m -> Addr -> Word8 -> m (Bus m)
write b a v = Bus <$> forM (busComponents b) \c@Component{..} ->
if compMatches a
then do
s <- compWrite compState a v
pure Component { compState = s, ..}
else pure c
read :: forall m. (MonadIO m, MonadThrow m) => Bus m -> Addr -> m (Maybe Word8)
read b a = case List.find (`compMatches` a) $ busComponents b of
Nothing -> pure Nothing
Just Component{..} -> Just <$> compRead compState a
|
