Replace ReadableIORef with IO (#2098)

* replaces the `ReadableIORef a` with an `IO a`, by pre-applying `readIORef` to the `IORef a`

The result of `IO a` is immutable `a`, so this is even safer than a newtype that needs a carefully chosen export list.

Basically this removes one file and some boilerplate from `Web.hs`.

app/game/Swarm/App.hs

@@ -19,7 +19,7 @@ import Control.Concurrent (forkIO, threadDelay)
 import Control.Lens (view, (%~), (&), (?~))
 import Control.Monad (forever, void, when)
 import Control.Monad.IO.Class (liftIO)
-import Data.IORef (newIORef, writeIORef)
+import Data.IORef (newIORef, readIORef, writeIORef)
 import Data.Text qualified as T
 import Data.Text.IO qualified as T
 import Graphics.Vty qualified as V
@@ -33,7 +33,6 @@ import Swarm.TUI.Model
 import Swarm.TUI.Model.StateUpdate
 import Swarm.TUI.Model.UI (uiAttrMap)
 import Swarm.TUI.View
-import Swarm.Util.ReadableIORef (mkReadonly)
 import Swarm.Version (getNewerReleaseVersion)
 import Swarm.Web
 import System.IO (stderr)
@@ -90,7 +89,7 @@ appMain opts = do
       eport <-
         Swarm.Web.startWebThread
           (userWebPort opts)
-          (mkReadonly appStateRef)
+          (readIORef appStateRef)
           chan
 
       let logP p = logEvent SystemLog Info "Web API" ("started on :" <> T.pack (show p))
@@ -137,7 +136,7 @@ demoWeb = do
       webMain
         Nothing
         demoPort
-        (mkReadonly appStateRef)
+        (readIORef appStateRef)
         chan
  where
   demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml"

src/swarm-util/Swarm/Util/ReadableIORef.hs

@@ -1,17 +0,0 @@
--- |
--- SPDX-License-Identifier: BSD-3-Clause
---
--- Ensures that access to an 'IORef' is read-only
--- by hiding behind a newtype.
-module Swarm.Util.ReadableIORef (mkReadonly, ReadableIORef, readIORef) where
-
-import Data.IORef (IORef)
-import Data.IORef qualified as R (readIORef)
-
-newtype ReadableIORef a = ReadableIORef (IORef a)
-
-mkReadonly :: IORef a -> ReadableIORef a
-mkReadonly = ReadableIORef
-
-readIORef :: ReadableIORef a -> IO a
-readIORef (ReadableIORef ref) = R.readIORef ref

src/swarm-web/Swarm/Web.hs

@@ -19,7 +19,6 @@
 --
 -- Missing endpoints:
 --
---   * TODO: #625 run endpoint to load definitions
 --   * TODO: #493 export the whole game state
 module Swarm.Web (
   startWebThread,
@@ -82,7 +81,6 @@ import Swarm.TUI.Model hiding (SwarmKeyDispatchers (..))
 import Swarm.TUI.Model.Goal
 import Swarm.TUI.Model.Repl (REPLHistItem, replHistory, replSeq)
 import Swarm.TUI.Model.UI
-import Swarm.Util.ReadableIORef
 import Swarm.Util.RingBuffer
 import Swarm.Web.Worldview
 import System.Timeout (timeout)
@@ -147,7 +145,8 @@ swarmApiMarkdown =
 -- ------------------------------------------------------------------
 
 mkApp ::
-  ReadableIORef AppState ->
+  -- | Read-only access to the current AppState
+  IO AppState ->
   -- | Writable channel to send events to the game
   BChan AppEvent ->
   Servant.Server SwarmAPI
@@ -167,57 +166,57 @@ mkApp state events =
     :<|> replHistHandler state
     :<|> mapViewHandler state
 
-robotsHandler :: ReadableIORef AppState -> Handler [Robot]
+robotsHandler :: IO AppState -> Handler [Robot]
 robotsHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   pure $ IM.elems $ appState ^. gameState . robotInfo . robotMap
 
-robotHandler :: ReadableIORef AppState -> RobotID -> Handler (Maybe Robot)
+robotHandler :: IO AppState -> RobotID -> Handler (Maybe Robot)
 robotHandler appStateRef (RobotID rid) = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   pure $ IM.lookup rid (appState ^. gameState . robotInfo . robotMap)
 
-prereqsHandler :: ReadableIORef AppState -> Handler [PrereqSatisfaction]
+prereqsHandler :: IO AppState -> Handler [PrereqSatisfaction]
 prereqsHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   case appState ^. gameState . winCondition of
     WinConditions _winState oc -> return $ getSatisfaction oc
     _ -> return []
 
-activeGoalsHandler :: ReadableIORef AppState -> Handler [Objective]
+activeGoalsHandler :: IO AppState -> Handler [Objective]
 activeGoalsHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   case appState ^. gameState . winCondition of
     WinConditions _winState oc -> return $ getActiveObjectives oc
     _ -> return []
 
-goalsGraphHandler :: ReadableIORef AppState -> Handler (Maybe GraphInfo)
+goalsGraphHandler :: IO AppState -> Handler (Maybe GraphInfo)
 goalsGraphHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   return $ case appState ^. gameState . winCondition of
     WinConditions _winState oc -> Just $ makeGraphInfo oc
     _ -> Nothing
 
-uiGoalHandler :: ReadableIORef AppState -> Handler GoalTracking
+uiGoalHandler :: IO AppState -> Handler GoalTracking
 uiGoalHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   return $ appState ^. uiState . uiGameplay . uiGoal . goalsContent
 
-goalsHandler :: ReadableIORef AppState -> Handler WinCondition
+goalsHandler :: IO AppState -> Handler WinCondition
 goalsHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   return $ appState ^. gameState . winCondition
 
-recogLogHandler :: ReadableIORef AppState -> Handler [SearchLog EntityName]
+recogLogHandler :: IO AppState -> Handler [SearchLog EntityName]
 recogLogHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   return $
     map (fmap (view entityName)) $
       appState ^. gameState . discovery . structureRecognition . recognitionLog
 
-recogFoundHandler :: ReadableIORef AppState -> Handler [StructureLocation]
+recogFoundHandler :: IO AppState -> Handler [StructureLocation]
 recogFoundHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   let registry = appState ^. gameState . discovery . structureRecognition . foundStructures
   return
     . map (uncurry StructureLocation)
@@ -238,21 +237,21 @@ codeRunHandler chan contents = do
   liftIO . writeBChan chan . Web $ RunWebCode contents
   return $ T.pack "Sent\n"
 
-pathsLogHandler :: ReadableIORef AppState -> Handler (RingBuffer CacheLogEntry)
+pathsLogHandler :: IO AppState -> Handler (RingBuffer CacheLogEntry)
 pathsLogHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   pure $ appState ^. gameState . pathCaching . pathCachingLog
 
-replHistHandler :: ReadableIORef AppState -> Handler [REPLHistItem]
+replHistHandler :: IO AppState -> Handler [REPLHistItem]
 replHistHandler appStateRef = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   let replHistorySeq = appState ^. uiState . uiGameplay . uiREPL . replHistory . replSeq
       items = toList replHistorySeq
   pure items
 
-mapViewHandler :: ReadableIORef AppState -> AreaDimensions -> Handler GridResponse
+mapViewHandler :: IO AppState -> AreaDimensions -> Handler GridResponse
 mapViewHandler appStateRef areaSize = do
-  appState <- liftIO (readIORef appStateRef)
+  appState <- liftIO appStateRef
   let maybeScenario = fst <$> appState ^. uiState . uiGameplay . scenarioRef
   pure $ case maybeScenario of
     Just s ->
@@ -273,7 +272,7 @@ webMain ::
   Maybe (MVar WebStartResult) ->
   Warp.Port ->
   -- | Read-only reference to the application state.
-  ReadableIORef AppState ->
+  IO AppState ->
   -- | Writable channel to send events to the game
   BChan AppEvent ->
   IO ()
@@ -318,7 +317,7 @@ defaultPort = 5357
 startWebThread ::
   Maybe Warp.Port ->
   -- | Read-only reference to the application state.
-  ReadableIORef AppState ->
+  IO AppState ->
   -- | Writable channel to send events to the game
   BChan AppEvent ->
   IO (Either String Warp.Port)

swarm.cabal

@@ -587,7 +587,6 @@ library swarm-util
     Swarm.Util.JSON
     Swarm.Util.Lens
     Swarm.Util.OccurrenceEncoder
-    Swarm.Util.ReadableIORef
     Swarm.Util.RingBuffer
     Swarm.Util.UnitInterval
     Swarm.Util.WindowedCounter
@@ -811,7 +810,6 @@ executable swarm
     swarm:swarm-lang,
     swarm:swarm-scenario,
     swarm:swarm-tui,
-    swarm:swarm-util,
     swarm:swarm-web,
     text,
     vty,