1 files changed, 48 insertions, 0 deletions
diff --git a/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs b/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs
new file mode 100644
index 0000000..730378a
--- /dev/null
+++ b/fig-emulator-gb/src/Fig/Emulator/GB/Bus.hs
@@ -0,0 +1,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