use applyWhen (#2180)

Continuing with the replacements started in this discussion: #2140 (comment)

src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs

@@ -42,7 +42,7 @@ import Swarm.Language.Syntax qualified as Syntax
 import Swarm.Language.Text.Markdown as Markdown (docToMark)
 import Swarm.Language.Typecheck (inferConst)
 import Swarm.Pretty (prettyText, prettyTextLine)
-import Swarm.Util (maximum0, showT)
+import Swarm.Util (applyWhen, maximum0, showT)
 
 -- * Types
 
@@ -170,10 +170,7 @@ capabilityRow PageAddress {..} em cap =
       then t
       else addLink (entityAddress <> "#" <> T.replace " " "-" t) t
   linkCommand c =
-    ( if T.null commandsAddress
-        then id
-        else addLink (commandsAddress <> "#" <> showT c)
-    )
+    applyWhen (not $ T.null commandsAddress) (addLink $ commandsAddress <> "#" <> showT c)
       . codeQuote
       $ constSyntax c
 

src/swarm-engine/Swarm/Game/State.hs

@@ -120,7 +120,7 @@ import Swarm.Language.Pipeline (processTermEither)
 import Swarm.Language.Syntax (SrcLoc (..), TSyntax, sLoc)
 import Swarm.Language.Value (Env)
 import Swarm.Log
-import Swarm.Util (uniq)
+import Swarm.Util (applyWhen, uniq)
 import Swarm.Util.Lens (makeLensesNoSigs)
 
 newtype Sha1 = Sha1 String
@@ -294,7 +294,7 @@ messageNotifications = to getNotif
     new = takeWhile (\l -> l ^. leTime > gs ^. messageInfo . lastSeenMessageTime) $ reverse allUniq
     -- creative players and system robots just see all messages (and focused robots logs)
     unchecked = gs ^. creativeMode || fromMaybe False (focusedRobot gs ^? _Just . systemRobot)
-    messages = (if unchecked then id else focusedOrLatestClose) (gs ^. messageInfo . messageQueue)
+    messages = applyWhen (not unchecked) focusedOrLatestClose (gs ^. messageInfo . messageQueue)
     allMessages = Seq.sort $ focusedLogs <> messages
     focusedLogs = maybe Empty (view robotLog) (focusedRobot gs)
     -- classic players only get to see messages that they said and a one message that they just heard
@@ -332,7 +332,7 @@ recalcViewCenterAndRedraw :: GameState -> GameState
 recalcViewCenterAndRedraw g =
   g
     & robotInfo .~ newRobotInfo
-    & (if ((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo then needsRedraw .~ True else id)
+    & applyWhen (((/=) `on` (^. viewCenter)) oldRobotInfo newRobotInfo) (needsRedraw .~ True)
  where
   oldRobotInfo = g ^. robotInfo
   newRobotInfo = recalcViewCenter oldRobotInfo

src/swarm-engine/Swarm/Game/Step/Const.hs

@@ -1415,7 +1415,7 @@ execConst runChildProg c vs s k = do
         return $ Out v s k
       else do
         time <- use $ temporal . ticks
-        return . (if remTime <= 1 then id else Waiting (addTicks (fromIntegral remTime) time)) $
+        return . applyWhen (remTime > 1) (Waiting (addTicks (fromIntegral remTime) time)) $
           Out v s (FImmediate c wf rf : k)
    where
     remTime = r ^. recipeTime

src/swarm-engine/Swarm/Game/Step/Util/Command.hs

@@ -63,6 +63,7 @@ import Swarm.Language.Requirements.Type qualified as R
 import Swarm.Language.Syntax
 import Swarm.Language.Text.Markdown qualified as Markdown
 import Swarm.Log
+import Swarm.Util (applyWhen)
 import System.Clock (TimeSpec)
 import Prelude hiding (Applicative (..), lookup)
 
@@ -156,9 +157,8 @@ purgeFarAwayWatches = do
 
   let isNearby = isNearbyOrExempt privileged myLoc
       f loc =
-        if not $ isNearby loc
-          then IS.delete rid
-          else id
+        applyWhen (not $ isNearby loc) $
+          IS.delete rid
 
   robotInfo . robotsWatching %= M.filter (not . IS.null) . M.mapWithKey f
 

src/swarm-lang/Swarm/Language/LSP/Hover.hs

@@ -242,7 +242,7 @@ explain trm = case trm ^. sTerm of
   internal description = literal $ description <> "\n**These should never show up in surface syntax.**"
   constGenSig c =
     let ity = inferConst c
-     in if ty `eq` ity then id else typeSignature (prettyText c) ity
+     in U.applyWhen (not $ ty `eq` ity) $ typeSignature (prettyText c) ity
 
 -- | Helper function to explain function application.
 --

src/swarm-lang/Swarm/Language/Requirements/Analysis.hs

@@ -26,6 +26,7 @@ import Swarm.Language.Requirements.Type
 import Swarm.Language.Syntax
 import Swarm.Language.Syntax.Direction (isCardinal)
 import Swarm.Language.Types
+import Swarm.Util (applyWhen)
 
 -- | Infer the requirements to execute/evaluate a term in a given
 --   context.
@@ -122,8 +123,8 @@ requirements tdCtx ctx =
       localReqCtx <- ask @ReqCtx
       localTDCtx <- ask @TDCtx
       let bodyReqs =
-            (if r then (singletonCap CRecursion <>) else id)
-              (requirements localTDCtx localReqCtx t1)
+            applyWhen r (singletonCap CRecursion <>) $
+              requirements localTDCtx localReqCtx t1
       local @ReqCtx (Ctx.addBinding x bodyReqs) $ go t2
     -- Using tydef requires CEnv, plus whatever the requirements are
     -- for the type itself.

src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs

@@ -16,6 +16,7 @@ import Swarm.Game.Location
 import Swarm.Game.Scenario.Topography.Area
 import Swarm.Game.Scenario.Topography.Grid
 import Swarm.Language.Syntax.Direction (AbsoluteDir (..))
+import Swarm.Util (applyWhen)
 
 newtype StructureName = StructureName Text
   deriving (Eq, Ord, Show, Generic, FromJSON, ToJSON)
@@ -49,7 +50,7 @@ reorientLandmark (Orientation upDir shouldFlip) (AreaDimensions width height) =
   transposeLoc (Location x y) = Location (-y) (-x)
   flipV (Location x y) = Location x $ -(height - 1) - y
   flipH (Location x y) = Location (width - 1 - x) y
-  flipping = if shouldFlip then flipV else id
+  flipping = applyWhen shouldFlip flipV
   rotational = case upDir of
     DNorth -> id
     DSouth -> flipH . flipV
@@ -63,7 +64,7 @@ applyOrientationTransform (Orientation upDir shouldFlip) =
  where
   f = rotational . flipping
   flipV = NE.reverse
-  flipping = if shouldFlip then flipV else id
+  flipping = applyWhen shouldFlip flipV
   rotational = case upDir of
     DNorth -> id
     DSouth -> NE.transpose . flipV . NE.transpose . flipV

src/swarm-tui/Swarm/TUI/Controller.hs

@@ -802,8 +802,8 @@ adjReplHistIndex d s =
   moveREPL :: REPLState -> REPLState
   moveREPL theRepl =
     newREPL
-      & (if replIndexIsAtInput (theRepl ^. replHistory) then saveLastEntry else id)
-      & (if oldEntry /= newEntry then showNewEntry else id)
+      & applyWhen (replIndexIsAtInput (theRepl ^. replHistory)) saveLastEntry
+      & applyWhen (oldEntry /= newEntry) showNewEntry
    where
     -- new AppState after moving the repl index
     newREPL :: REPLState

src/swarm-tui/Swarm/TUI/Editor/View.hs

@@ -25,6 +25,7 @@ import Swarm.TUI.Panel
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.TUI.View.CellDisplay (renderDisplay)
 import Swarm.TUI.View.Util qualified as VU
+import Swarm.Util (applyWhen)
 
 extractTerrainMap :: UIState -> TerrainMap
 extractTerrainMap uis =
@@ -71,9 +72,8 @@ drawWorldEditor toplevelFocusRing uis =
     clickable n $ transformation w
    where
     transformation =
-      if Just n == maybeCurrentFocus
-        then withAttr BL.listSelectedFocusedAttr
-        else id
+      applyWhen (Just n == maybeCurrentFocus) $
+        withAttr BL.listSelectedFocusedAttr
 
   swatchContent list drawFunc =
     maybe emptyWidget drawFunc selectedThing

src/swarm-tui/Swarm/TUI/Launch/View.hs

@@ -27,7 +27,7 @@ import Swarm.TUI.Launch.Prep
 import Swarm.TUI.Model.Name
 import Swarm.TUI.View.Attribute.Attr
 import Swarm.TUI.View.Util (EllipsisSide (Beginning), withEllipsis)
-import Swarm.Util (brackets, parens)
+import Swarm.Util (applyWhen, brackets, parens)
 
 drawFileBrowser :: FB.FileBrowser Name -> Widget Name
 drawFileBrowser b =
@@ -74,9 +74,7 @@ drawLaunchConfigPanel (LaunchOptions lc launchParams) =
   validatedOptions = toValidatedParams launchParams
   LaunchControls (FileBrowserControl fb _ isFbDisplayed) seedEditor ring displayedFor = lc
   addFileBrowser =
-    if isFbDisplayed
-      then (drawFileBrowser fb :)
-      else id
+    applyWhen isFbDisplayed (drawFileBrowser fb :)
 
   getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable
   getFocusedConfigPanel = case focusGetCurrent ring of
@@ -86,9 +84,8 @@ drawLaunchConfigPanel (LaunchOptions lc launchParams) =
   isFocused = (== getFocusedConfigPanel) . Just
 
   highlightIfFocused x =
-    if isFocused x
-      then withDefAttr highlightAttr
-      else id
+    applyWhen (isFocused x) $
+      withDefAttr highlightAttr
 
   mkButton name label =
     clickable (ScenarioConfigControl $ ScenarioConfigPanelControl name)

src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs

@@ -23,6 +23,7 @@ import Servant.Docs qualified as SD
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Objective.WinCheck
 import Swarm.TUI.Model.Name
+import Swarm.Util (applyWhen)
 
 -- | These are intended to be used as keys in a map
 -- of lists of goals.
@@ -118,8 +119,6 @@ constructGoalMap showHidden oc =
       filter (maybe False previewable . view objectivePrerequisite) inactiveGoals
 
   suppressHidden =
-    if showHidden
-      then id
-      else filter $ not . view objectiveHidden
+    applyWhen (not showHidden) $ filter $ not . view objectiveHidden
 
   (activeGoals, inactiveGoals) = partitionActiveObjectives oc

src/swarm-tui/Swarm/TUI/Model/Repl.hs

@@ -73,6 +73,7 @@ import Servant.Docs qualified as SD
 import Swarm.Language.Syntax (SrcLoc (..))
 import Swarm.Language.Types
 import Swarm.TUI.Model.Name
+import Swarm.Util (applyWhen)
 import Swarm.Util.Lens (makeLensesNoSigs)
 import Prelude hiding (Applicative (..))
 
@@ -333,7 +334,7 @@ newREPLEditor t = applyEdit gotoEnd $ editorText REPLInput (Just 1) t
  where
   ls = T.lines t
   pos = (length ls - 1, T.length (last ls))
-  gotoEnd = if null ls then id else TZ.moveCursor pos
+  gotoEnd = applyWhen (not $ null ls) $ TZ.moveCursor pos
 
 initREPLState :: REPLHistory -> REPLState
 initREPLState hist =

src/swarm-tui/Swarm/TUI/Panel.hs

@@ -18,6 +18,7 @@ import Brick.Focus
 import Brick.Widgets.Border
 import Control.Lens
 import Swarm.TUI.Border
+import Swarm.Util (applyWhen)
 
 data Panel n = Panel
   {_panelName :: n, _panelLabels :: BorderLabels n, _panelContent :: Widget n}
@@ -32,7 +33,7 @@ drawPanel attr fr = withFocusRing fr drawPanel'
  where
   drawPanel' :: Bool -> Panel n -> Widget n
   drawPanel' focused p =
-    (if focused then overrideAttr borderAttr attr else id) $
+    applyWhen focused (overrideAttr borderAttr attr) $
       borderWithLabels (p ^. panelLabels) (p ^. panelContent)
 
 -- | Create a panel.

src/swarm-tui/Swarm/TUI/View.hs

@@ -407,9 +407,8 @@ drawMainMenuEntry s = \case
   Quit -> txt "Quit"
  where
   highlightMessages =
-    if s ^. runtimeState . eventLog . notificationsCount > 0
-      then withAttr notifAttr
-      else id
+    applyWhen (s ^. runtimeState . eventLog . notificationsCount > 0) $
+      withAttr notifAttr
 
 drawAboutMenuUI :: Maybe Text -> Widget Name
 drawAboutMenuUI Nothing = centerLayer $ txt "About swarm!"
@@ -578,8 +577,8 @@ drawTPS s = hBox (tpsInfo : rateInfo)
     | s ^. uiState . uiGameplay . uiTiming . uiShowFPS =
         [ txt " ("
         , let tpf = s ^. uiState . uiGameplay . uiTiming . uiTPF
-           in (if tpf >= fromIntegral ticksPerFrameCap then withAttr redAttr else id)
-                (str (printf "%0.1f" tpf))
+           in applyWhen (tpf >= fromIntegral ticksPerFrameCap) (withAttr redAttr) $
+                str (printf "%0.1f" tpf)
         , txt " tpf, "
         , str (printf "%0.1f" (s ^. uiState . uiGameplay . uiTiming . uiFPS))
         , txt " fps)"
@@ -786,7 +785,7 @@ messagesWidget :: GameState -> [Widget Name]
 messagesWidget gs = widgetList
  where
   widgetList = focusNewest . map drawLogEntry' $ gs ^. messageNotifications . notificationsContent
-  focusNewest = if gs ^. temporal . paused then id else over _last visible
+  focusNewest = applyWhen (not $ gs ^. temporal . paused) $ over _last visible
   drawLogEntry' e =
     withAttr (colorLogs e) $
       hBox
@@ -1067,7 +1066,7 @@ drawItem sel i _ (Separator l) =
   -- element of the list, once it scrolls off the top of the viewport
   -- it will never become visible again.
   -- See https://github.com/jtdaugherty/brick/issues/336#issuecomment-921220025
-  (if sel == Just (i + 1) then visible else id) $ hBorderWithLabel (txt l)
+  applyWhen (sel == Just (i + 1)) visible $ hBorderWithLabel (txt l)
 drawItem _ _ _ (InventoryEntry n e) = drawLabelledEntityName e <+> showCount n
  where
   showCount = padLeft Max . str . show
@@ -1373,7 +1372,7 @@ drawRobotLog s =
   logEntriesToShow = getLogEntriesToShow s
   n = length logEntriesToShow
   drawEntry i e =
-    (if i == n - 1 && s ^. uiState . uiGameplay . uiScrollToEnd then visible else id) $
+    applyWhen (i == n - 1 && s ^. uiState . uiGameplay . uiScrollToEnd) visible $
       drawLogEntry (not allMe) e
 
   rid = s ^? gameState . to focusedRobot . _Just . robotID

src/swarm-tui/Swarm/TUI/View/CellDisplay.hs

@@ -161,7 +161,7 @@ displayEntityCell worldEditor ri coords =
       Coords xy = locToCoords $ P $ toHeading d
 
   displayForEntity :: EntityPaint -> Display
-  displayForEntity e = (if isKnownFunc ri e then id else hidden) $ getDisplay e
+  displayForEntity e = applyWhen (not $ isKnownFunc ri e) hidden $ getDisplay e
 
 -- | Get the 'Display' for a specific location, by combining the
 --   'Display's for the terrain, entity, and robots at the location, and

src/swarm-tui/Swarm/TUI/View/Robot.hs

@@ -133,10 +133,7 @@ rowHdr :: RowHdr Name RobotWidgetRow
 rowHdr =
   RowHdr
     { draw = \_ (WdthD wd) (RowHdrCtxt (Sel s)) rh ->
-        let attrFn =
-              if s
-                then id
-                else withAttr rowHdrAttr
+        let attrFn = applyWhen (not s) $ withAttr rowHdrAttr
          in attrFn $ padRight (Pad $ if wd > 0 then 0 else 1) $ padLeft Max (str $ show rh)
     , width = \_ rh -> RowHdrW . (+ 2) . maximum0 $ map (length . show) rh
     , toRH = \_ (Ix i) -> i + 1
@@ -331,7 +328,7 @@ mkLibraryEntries c =
           ]
       nameTxt = r ^. robotName
 
-    highlightSystem = if r ^. systemRobot then withAttr highlightAttr else id
+    highlightSystem = applyWhen (r ^. systemRobot) $ withAttr highlightAttr
 
     ageStr
       | age < 60 = show age <> "sec"

src/swarm-tui/Swarm/TUI/View/Robot/Details.hs

@@ -22,6 +22,7 @@ import Swarm.Pretty (prettyText)
 import Swarm.TUI.Model.Name
 import Swarm.TUI.View.Attribute.Attr (boldAttr, cyanAttr)
 import Swarm.TUI.View.Robot.Type
+import Swarm.Util (applyWhen)
 
 renderRobotDetails :: FocusRing Name -> Robot -> RobotDetailsPaneState -> Widget Name
 renderRobotDetails ring r paneState =
@@ -42,7 +43,7 @@ renderRobotDetails ring r paneState =
     ]
  where
   highlightBorderFor n =
-    if isFocused then overrideAttr borderAttr cyanAttr else id
+    applyWhen isFocused $ overrideAttr borderAttr cyanAttr
    where
     isFocused = focusGetCurrent ring == Just (RobotsListDialog $ SingleRobotDetails n)
 

src/swarm-util/Data/BoolExpr/Simplify.hs

@@ -52,9 +52,8 @@ replace _ BFalse = BFalse
 replace m c@(BConst x) = case M.lookup varname m of
   Nothing -> c
   Just val ->
-    if txform val
+    if isPositive == val
       then BTrue
       else BFalse
  where
   (varname, isPositive) = extractConstFromSigned x
-  txform = if isPositive then id else not

test/integration/Main.hs

@@ -80,7 +80,7 @@ import Swarm.TUI.Model (
 import Swarm.TUI.Model.DebugOption (DebugOption (LoadTestingScenarios))
 import Swarm.TUI.Model.StateUpdate (constructAppState, initPersistentState)
 import Swarm.TUI.Model.UI (UIState)
-import Swarm.Util (findAllWithExt)
+import Swarm.Util (applyWhen, findAllWithExt)
 import Swarm.Util.RingBuffer qualified as RB
 import Swarm.Util.Yaml (decodeFileEitherE)
 import System.FilePath (splitDirectories)
@@ -579,7 +579,7 @@ testEditorFiles =
   testTextInFile :: Bool -> String -> Text -> FilePath -> TestTree
   testTextInFile whitespace name t fp = testCase name $ do
     let removeLW' = T.unlines . map (T.dropWhile isSpace) . T.lines
-        removeLW = if whitespace then removeLW' else id
+        removeLW = applyWhen whitespace removeLW'
     f <- T.readFile fp
     assertBool
       ( "EDITOR FILE IS NOT UP TO DATE!\n"

test/integration/TestRecipeCoverage.hs

@@ -12,7 +12,7 @@ import Data.Set qualified as Set
 import Data.Text qualified as T
 import Swarm.Doc.Gen
 import Swarm.Game.Entity (Entity, EntityName, entityName)
-import Swarm.Util (quote)
+import Swarm.Util (applyWhen, quote)
 import Test.Tasty
 import Test.Tasty.ExpectedFailure (expectFailBecause)
 import Test.Tasty.HUnit
@@ -44,9 +44,8 @@ testRecipeCoverage = do
 expectNonCovered :: Entity -> TestTree -> TestTree
 expectNonCovered e =
   let name = T.toCaseFold (view entityName e)
-   in if name `elem` nonCoveredList
-        then expectFailBecause "More recipes needed (#1268)"
-        else id
+   in applyWhen (name `elem` nonCoveredList) $
+        expectFailBecause "More recipes needed (#1268)"
 
 -- | Known non-covered entities that need a recipe.
 nonCoveredList :: [EntityName]