packages feed

swarm-0.4: src/Swarm/TUI/Model/Goal.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- A UI-centric model for Objective presentation.
module Swarm.TUI.Model.Goal where

import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Lens (makeLenses)
import Data.Aeson
import Data.List.NonEmpty (NonEmpty, nonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (mapMaybe)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
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 (listEnums)

-- | These are intended to be used as keys in a map
-- of lists of goals.
data GoalStatus
  = -- | Goals in this category have other goals as prerequisites.
    -- However, they are only displayed if the "previewable" attribute
    -- is `true`.
    Upcoming
  | -- | Goals in this category may be pursued in parallel.
    -- However, they are only displayed if the "hidden" attribute
    -- is `false`.
    Active
  | -- | A goal's programmatic condition, as well as all its prerequisites, were completed.
    -- This is a "latch" mechanism; at some point the conditions required to meet the goal may
    -- no longer hold. Nonetheless, the goal remains "completed".
    Completed
  | -- | A goal that can no longer be achieved.
    -- If this goal is not an "optional" goal, then the player
    -- also "Loses" the scenario.
    --
    -- Note that currently the only way to "Fail" a goal is by way
    -- of a negative prerequisite that was completed.
    Failed
  deriving (Show, Eq, Ord, Bounded, Enum, Generic, ToJSON, ToJSONKey)

type CategorizedGoals = Map GoalStatus (NonEmpty Objective)

data GoalEntry
  = Header GoalStatus
  | Goal GoalStatus Objective
  | Spacer

shouldSkipSelection :: GoalEntry -> Bool
shouldSkipSelection = \case
  Goal _ _ -> False
  _ -> True

data GoalTracking = GoalTracking
  { announcements :: [Announcement]
  -- ^ TODO: #1044 the actual contents of these are not used yet,
  -- other than as a flag to pop up the Goal dialog.
  , goals :: CategorizedGoals
  }
  deriving (Generic, ToJSON)

instance ToSample GoalTracking where
  toSamples _ = SD.noSamples

data GoalDisplay = GoalDisplay
  { _goalsContent :: GoalTracking
  , _listWidget :: BL.List Name GoalEntry
  -- ^ required for maintaining the selection/navigation
  -- state among list items
  , _focus :: FocusRing Name
  }

makeLenses ''GoalDisplay

emptyGoalDisplay :: GoalDisplay
emptyGoalDisplay =
  GoalDisplay
    (GoalTracking mempty mempty)
    (BL.list (GoalWidgets ObjectivesList) mempty 1)
    (focusRing $ map GoalWidgets listEnums)

hasAnythingToShow :: GoalTracking -> Bool
hasAnythingToShow (GoalTracking ann g) = not (null ann && null g)

hasMultipleGoals :: GoalTracking -> Bool
hasMultipleGoals gt =
  goalCount > 1
 where
  goalCount = sum . M.elems . M.map NE.length . goals $ gt

constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap isCheating objectiveCompletion@(ObjectiveCompletion buckets _) =
  M.fromList $
    mapMaybe (traverse nonEmpty) categoryList
 where
  categoryList =
    [ (Upcoming, displayableInactives)
    , (Active, suppressHidden activeGoals)
    , (Completed, completed buckets)
    , (Failed, unwinnable buckets)
    ]

  displayableInactives =
    suppressHidden $
      filter (maybe False previewable . _objectivePrerequisite) inactiveGoals

  suppressHidden =
    if isCheating
      then id
      else filter $ not . _objectiveHidden

  (activeGoals, inactiveGoals) = partitionActiveObjectives objectiveCompletion