packages feed

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

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

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

import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Lens (makeLenses, view, (^..))
import Data.Aeson
import Data.List.Extra (enumerate)
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 (applyWhen)

-- | 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.samples
      [ GoalTracking mempty mempty
      -- TODO: #1552 add simple objective sample
      ]

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 enumerate)

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 showHidden oc =
  M.fromList $
    mapMaybe (traverse nonEmpty) categoryList
 where
  categoryList =
    [ (Upcoming, displayableInactives)
    , (Active, suppressHidden activeGoals)
    , (Completed, oc ^.. completedObjectives)
    , (Failed, oc ^.. unwinnableObjectives)
    ]

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

  suppressHidden =
    applyWhen (not showHidden) $ filter $ not . view objectiveHidden

  (activeGoals, inactiveGoals) = partitionActiveObjectives oc