diff --git a/src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs b/src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs index 68265bd54..61feb18ad 100644 --- a/src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index d02dcf40e..5c1df4d5e 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/Step/Const.hs b/src/swarm-engine/Swarm/Game/Step/Const.hs index 1c62d0ad0..74b336f13 100644 --- a/src/swarm-engine/Swarm/Game/Step/Const.hs +++ b/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 diff --git a/src/swarm-engine/Swarm/Game/Step/Util/Command.hs b/src/swarm-engine/Swarm/Game/Step/Util/Command.hs index a6dd19d87..037cb008c 100644 --- a/src/swarm-engine/Swarm/Game/Step/Util/Command.hs +++ b/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 diff --git a/src/swarm-lang/Swarm/Language/LSP/Hover.hs b/src/swarm-lang/Swarm/Language/LSP/Hover.hs index 6a62b9bee..c2c1a9f29 100644 --- a/src/swarm-lang/Swarm/Language/LSP/Hover.hs +++ b/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. -- diff --git a/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs b/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs index 89a03c455..b04d4e35b 100644 --- a/src/swarm-lang/Swarm/Language/Requirements/Analysis.hs +++ b/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. diff --git a/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs b/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs index d6f77a94b..0026a1ac6 100644 --- a/src/swarm-topography/Swarm/Game/Scenario/Topography/Placement.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 3eb787ff8..665d00667 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Editor/View.hs b/src/swarm-tui/Swarm/TUI/Editor/View.hs index 057db5183..7e851ed18 100644 --- a/src/swarm-tui/Swarm/TUI/Editor/View.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Launch/View.hs b/src/swarm-tui/Swarm/TUI/Launch/View.hs index 7f4b532c0..91b917a3b 100644 --- a/src/swarm-tui/Swarm/TUI/Launch/View.hs +++ b/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) diff --git a/src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs b/src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs index c02ff33ea..e1acff4ff 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/Model/Repl.hs b/src/swarm-tui/Swarm/TUI/Model/Repl.hs index 1673194f0..f190829eb 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Repl.hs +++ b/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 = diff --git a/src/swarm-tui/Swarm/TUI/Panel.hs b/src/swarm-tui/Swarm/TUI/Panel.hs index c4b44e6e2..8361aeecd 100644 --- a/src/swarm-tui/Swarm/TUI/Panel.hs +++ b/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. diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index 3f4ff954d..64f2a179e 100644 --- a/src/swarm-tui/Swarm/TUI/View.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs b/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs index 5b31df791..7f6a5f01c 100644 --- a/src/swarm-tui/Swarm/TUI/View/CellDisplay.hs +++ b/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 diff --git a/src/swarm-tui/Swarm/TUI/View/Robot.hs b/src/swarm-tui/Swarm/TUI/View/Robot.hs index 18e30c5cc..1d90778d9 100644 --- a/src/swarm-tui/Swarm/TUI/View/Robot.hs +++ b/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" diff --git a/src/swarm-tui/Swarm/TUI/View/Robot/Details.hs b/src/swarm-tui/Swarm/TUI/View/Robot/Details.hs index 7ac6eb3be..40bcb17c2 100644 --- a/src/swarm-tui/Swarm/TUI/View/Robot/Details.hs +++ b/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) diff --git a/src/swarm-util/Data/BoolExpr/Simplify.hs b/src/swarm-util/Data/BoolExpr/Simplify.hs index b36566ce8..ac0507e22 100644 --- a/src/swarm-util/Data/BoolExpr/Simplify.hs +++ b/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 diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 67341427f..f5ac0cbd0 100644 --- a/test/integration/Main.hs +++ b/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" diff --git a/test/integration/TestRecipeCoverage.hs b/test/integration/TestRecipeCoverage.hs index 4bf3dcce1..a99dd32e0 100644 --- a/test/integration/TestRecipeCoverage.hs +++ b/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]