Skip to content

Commit

Permalink
use applyWhen
Browse files Browse the repository at this point in the history
  • Loading branch information
kostmo committed Oct 15, 2024
1 parent 0fda99f commit b1eeb23
Show file tree
Hide file tree
Showing 20 changed files with 49 additions and 52 deletions.
8 changes: 4 additions & 4 deletions src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs
Original file line number Diff line number Diff line change
Expand Up @@ -170,10 +170,10 @@ 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

Check failure on line 173 in src/swarm-doc/Swarm/Doc/Wiki/Cheatsheet.hs

View workflow job for this annotation

GitHub Actions / Haskell-CI - windows-latest - ghc-9.8.2

Variable not in scope:
(not $ T.null commandsAddress)
( addLink (commandsAddress <> "#" <> showT c)
)
. codeQuote
$ constSyntax c

Expand Down
6 changes: 3 additions & 3 deletions src/swarm-engine/Swarm/Game/State.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/swarm-engine/Swarm/Game/Step/Const.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/swarm-engine/Swarm/Game/Step/Util/Command.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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

Expand Down
2 changes: 1 addition & 1 deletion src/swarm-lang/Swarm/Language/LSP/Hover.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
--
Expand Down
5 changes: 4 additions & 1 deletion src/swarm-lang/Swarm/Language/Requirements/Analysis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -122,7 +123,9 @@ requirements tdCtx ctx =
localReqCtx <- ask @ReqCtx
localTDCtx <- ask @TDCtx
let bodyReqs =
(if r then (singletonCap CRecursion <>) else id)
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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/swarm-tui/Swarm/TUI/Controller.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/swarm-tui/Swarm/TUI/Editor/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down
11 changes: 4 additions & 7 deletions src/swarm-tui/Swarm/TUI/Launch/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand All @@ -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)
Expand Down
5 changes: 2 additions & 3 deletions src/swarm-tui/Swarm/TUI/Model/Dialog/Goal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
3 changes: 2 additions & 1 deletion src/swarm-tui/Swarm/TUI/Model/Repl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..))

Expand Down Expand Up @@ -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 =
Expand Down
3 changes: 2 additions & 1 deletion src/swarm-tui/Swarm/TUI/Panel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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}
Expand All @@ -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.
Expand Down
13 changes: 6 additions & 7 deletions src/swarm-tui/Swarm/TUI/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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!"
Expand Down Expand Up @@ -578,7 +577,7 @@ 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)
in (applyWhen (tpf >= fromIntegral ticksPerFrameCap) $ withAttr redAttr)
(str (printf "%0.1f" tpf))
, txt " tpf, "
, str (printf "%0.1f" (s ^. uiState . uiGameplay . uiTiming . uiFPS))
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion src/swarm-tui/Swarm/TUI/View/CellDisplay.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 2 additions & 5 deletions src/swarm-tui/Swarm/TUI/View/Robot.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down
3 changes: 2 additions & 1 deletion src/swarm-tui/Swarm/TUI/View/Robot/Details.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand All @@ -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)

Expand Down
3 changes: 1 addition & 2 deletions src/swarm-util/Data/BoolExpr/Simplify.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
2 changes: 1 addition & 1 deletion test/integration/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
5 changes: 2 additions & 3 deletions test/integration/TestRecipeCoverage.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down

0 comments on commit b1eeb23

Please sign in to comment.