Skip to content

Commit

Permalink
Fix completed scenario to show green status (#2312)
Browse files Browse the repository at this point in the history
* add lenses to a `Metric`
* decide completion status based on best record (either one will do)

<img width="877" alt="Screenshot 2025-02-08 at 3 33 27 PM" src="https://github.com/user-attachments/assets/f5c85078-dac0-4cd2-94de-d5357c352f29" />
  • Loading branch information
xsebek authored Feb 8, 2025
1 parent f2b485b commit 3039720
Show file tree
Hide file tree
Showing 3 changed files with 29 additions and 8 deletions.
4 changes: 2 additions & 2 deletions src/swarm-engine/Swarm/Game/Scenario/Scoring/Best.hs
Original file line number Diff line number Diff line change
Expand Up @@ -144,7 +144,7 @@ getBestGroups ::
getBestGroups =
rearrangeTuples . M.toList . bestToMap
where
groupByStartTime = NE.groupAllWith $ view scenarioStarted . getMetric . snd
groupByStartTime = NE.groupAllWith $ view scenarioStarted . view metricData . snd
rearrangeTuples = map (snd . NE.head &&& NE.map fst) . groupByStartTime

bestToMap :: BestRecords -> Map BestByCriteria ProgressMetric
Expand All @@ -161,4 +161,4 @@ getBestGroups =
]

ensurePresent x =
(getMetric x ^. scenarioAttemptMetrics . scenarioCodeMetrics) >> Just x
(x ^. metricData . scenarioAttemptMetrics . scenarioCodeMetrics) >> Just x
26 changes: 22 additions & 4 deletions src/swarm-engine/Swarm/Game/Scenario/Scoring/GenericMetrics.hs
Original file line number Diff line number Diff line change
@@ -1,15 +1,25 @@
{-# LANGUAGE TemplateHaskell #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Data types and functions applicable across different
-- scoring methods.
module Swarm.Game.Scenario.Scoring.GenericMetrics where
module Swarm.Game.Scenario.Scoring.GenericMetrics (
Progress (..),
Metric (Metric),
metricProgress,
metricData,
chooseBetter,
) where

import Control.Lens
import Data.Aeson
import Data.Ord (Down (Down))
import GHC.Generics (Generic)
import Swarm.Util (maxOn)
import Swarm.Util.JSON (optionsUntagged)
import Swarm.Util.Lens (makeLensesNoSigs)

-- | This is a subset of the "ScenarioStatus" type
-- that excludes the "NotStarted" case.
Expand All @@ -24,11 +34,19 @@ instance FromJSON Progress where
instance ToJSON Progress where
toJSON = genericToJSON optionsUntagged

data Metric a = Metric Progress a
data Metric a = Metric
{ _metricProgress :: Progress
, _metricData :: a
}
deriving (Eq, Ord, Show, Read, Generic, FromJSON, ToJSON)

getMetric :: Metric a -> a
getMetric (Metric _ x) = x
makeLensesNoSigs ''Metric

-- | The player progress, so that we know if this game was completed.
metricProgress :: Lens' (Metric a) Progress

-- | Metric data, for example start and end time.
metricData :: Lens' (Metric a) a

-- | This encodes the notion of "more play is better"
-- for incomplete games (rationale: more play = more fun),
Expand Down
7 changes: 5 additions & 2 deletions src/swarm-tui/Swarm/TUI/View.hs
Original file line number Diff line number Diff line change
Expand Up @@ -230,10 +230,13 @@ drawNewGameMenuUI (l :| ls) launchOptions = case displayedFor of
drawScenarioItem (SICollection nm _) = padRight (Pad 1) (withAttr boldAttr $ txt " > ") <+> txt nm
drawStatusInfo s si = case si ^. scenarioStatus of
NotStarted -> txt ""
Played _initialScript (Metric Attempted _) _ -> case s ^. scenarioOperation . scenarioObjectives of
Played _script _latestMetric best | isCompleted best -> withAttr greenAttr $ txt ""
Played {} -> case s ^. scenarioOperation . scenarioObjectives of
[] -> withAttr cyanAttr $ txt ""
_ -> withAttr yellowAttr $ txt ""
Played _initialScript (Metric Completed _) _ -> withAttr greenAttr $ txt ""

isCompleted :: BestRecords -> Bool
isCompleted best = best ^. scenarioBestByTime . metricProgress == Completed

describeStatus :: ScenarioStatus -> Widget n
describeStatus = \case
Expand Down

0 comments on commit 3039720

Please sign in to comment.