{-# 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 (Int -> GoalStatus -> ShowS
[GoalStatus] -> ShowS
GoalStatus -> String
(Int -> GoalStatus -> ShowS)
-> (GoalStatus -> String)
-> ([GoalStatus] -> ShowS)
-> Show GoalStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GoalStatus -> ShowS
showsPrec :: Int -> GoalStatus -> ShowS
$cshow :: GoalStatus -> String
show :: GoalStatus -> String
$cshowList :: [GoalStatus] -> ShowS
showList :: [GoalStatus] -> ShowS
Show, GoalStatus -> GoalStatus -> Bool
(GoalStatus -> GoalStatus -> Bool)
-> (GoalStatus -> GoalStatus -> Bool) -> Eq GoalStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GoalStatus -> GoalStatus -> Bool
== :: GoalStatus -> GoalStatus -> Bool
$c/= :: GoalStatus -> GoalStatus -> Bool
/= :: GoalStatus -> GoalStatus -> Bool
Eq, Eq GoalStatus
Eq GoalStatus =>
(GoalStatus -> GoalStatus -> Ordering)
-> (GoalStatus -> GoalStatus -> Bool)
-> (GoalStatus -> GoalStatus -> Bool)
-> (GoalStatus -> GoalStatus -> Bool)
-> (GoalStatus -> GoalStatus -> Bool)
-> (GoalStatus -> GoalStatus -> GoalStatus)
-> (GoalStatus -> GoalStatus -> GoalStatus)
-> Ord GoalStatus
GoalStatus -> GoalStatus -> Bool
GoalStatus -> GoalStatus -> Ordering
GoalStatus -> GoalStatus -> GoalStatus
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GoalStatus -> GoalStatus -> Ordering
compare :: GoalStatus -> GoalStatus -> Ordering
$c< :: GoalStatus -> GoalStatus -> Bool
< :: GoalStatus -> GoalStatus -> Bool
$c<= :: GoalStatus -> GoalStatus -> Bool
<= :: GoalStatus -> GoalStatus -> Bool
$c> :: GoalStatus -> GoalStatus -> Bool
> :: GoalStatus -> GoalStatus -> Bool
$c>= :: GoalStatus -> GoalStatus -> Bool
>= :: GoalStatus -> GoalStatus -> Bool
$cmax :: GoalStatus -> GoalStatus -> GoalStatus
max :: GoalStatus -> GoalStatus -> GoalStatus
$cmin :: GoalStatus -> GoalStatus -> GoalStatus
min :: GoalStatus -> GoalStatus -> GoalStatus
Ord, GoalStatus
GoalStatus -> GoalStatus -> Bounded GoalStatus
forall a. a -> a -> Bounded a
$cminBound :: GoalStatus
minBound :: GoalStatus
$cmaxBound :: GoalStatus
maxBound :: GoalStatus
Bounded, Int -> GoalStatus
GoalStatus -> Int
GoalStatus -> [GoalStatus]
GoalStatus -> GoalStatus
GoalStatus -> GoalStatus -> [GoalStatus]
GoalStatus -> GoalStatus -> GoalStatus -> [GoalStatus]
(GoalStatus -> GoalStatus)
-> (GoalStatus -> GoalStatus)
-> (Int -> GoalStatus)
-> (GoalStatus -> Int)
-> (GoalStatus -> [GoalStatus])
-> (GoalStatus -> GoalStatus -> [GoalStatus])
-> (GoalStatus -> GoalStatus -> [GoalStatus])
-> (GoalStatus -> GoalStatus -> GoalStatus -> [GoalStatus])
-> Enum GoalStatus
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: GoalStatus -> GoalStatus
succ :: GoalStatus -> GoalStatus
$cpred :: GoalStatus -> GoalStatus
pred :: GoalStatus -> GoalStatus
$ctoEnum :: Int -> GoalStatus
toEnum :: Int -> GoalStatus
$cfromEnum :: GoalStatus -> Int
fromEnum :: GoalStatus -> Int
$cenumFrom :: GoalStatus -> [GoalStatus]
enumFrom :: GoalStatus -> [GoalStatus]
$cenumFromThen :: GoalStatus -> GoalStatus -> [GoalStatus]
enumFromThen :: GoalStatus -> GoalStatus -> [GoalStatus]
$cenumFromTo :: GoalStatus -> GoalStatus -> [GoalStatus]
enumFromTo :: GoalStatus -> GoalStatus -> [GoalStatus]
$cenumFromThenTo :: GoalStatus -> GoalStatus -> GoalStatus -> [GoalStatus]
enumFromThenTo :: GoalStatus -> GoalStatus -> GoalStatus -> [GoalStatus]
Enum, (forall x. GoalStatus -> Rep GoalStatus x)
-> (forall x. Rep GoalStatus x -> GoalStatus) -> Generic GoalStatus
forall x. Rep GoalStatus x -> GoalStatus
forall x. GoalStatus -> Rep GoalStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GoalStatus -> Rep GoalStatus x
from :: forall x. GoalStatus -> Rep GoalStatus x
$cto :: forall x. Rep GoalStatus x -> GoalStatus
to :: forall x. Rep GoalStatus x -> GoalStatus
Generic, [GoalStatus] -> Value
[GoalStatus] -> Encoding
GoalStatus -> Bool
GoalStatus -> Value
GoalStatus -> Encoding
(GoalStatus -> Value)
-> (GoalStatus -> Encoding)
-> ([GoalStatus] -> Value)
-> ([GoalStatus] -> Encoding)
-> (GoalStatus -> Bool)
-> ToJSON GoalStatus
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GoalStatus -> Value
toJSON :: GoalStatus -> Value
$ctoEncoding :: GoalStatus -> Encoding
toEncoding :: GoalStatus -> Encoding
$ctoJSONList :: [GoalStatus] -> Value
toJSONList :: [GoalStatus] -> Value
$ctoEncodingList :: [GoalStatus] -> Encoding
toEncodingList :: [GoalStatus] -> Encoding
$comitField :: GoalStatus -> Bool
omitField :: GoalStatus -> Bool
ToJSON, ToJSONKeyFunction [GoalStatus]
ToJSONKeyFunction GoalStatus
ToJSONKeyFunction GoalStatus
-> ToJSONKeyFunction [GoalStatus] -> ToJSONKey GoalStatus
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction GoalStatus
toJSONKey :: ToJSONKeyFunction GoalStatus
$ctoJSONKeyList :: ToJSONKeyFunction [GoalStatus]
toJSONKeyList :: ToJSONKeyFunction [GoalStatus]
ToJSONKey)

type CategorizedGoals = Map GoalStatus (NonEmpty Objective)

data GoalEntry
  = Header GoalStatus
  | Goal GoalStatus Objective
  | Spacer

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

data GoalTracking = GoalTracking
  { GoalTracking -> [Announcement]
announcements :: [Announcement]
  -- ^ TODO: #1044 the actual contents of these are not used yet,
  -- other than as a flag to pop up the Goal dialog.
  , GoalTracking -> CategorizedGoals
goals :: CategorizedGoals
  }
  deriving ((forall x. GoalTracking -> Rep GoalTracking x)
-> (forall x. Rep GoalTracking x -> GoalTracking)
-> Generic GoalTracking
forall x. Rep GoalTracking x -> GoalTracking
forall x. GoalTracking -> Rep GoalTracking x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GoalTracking -> Rep GoalTracking x
from :: forall x. GoalTracking -> Rep GoalTracking x
$cto :: forall x. Rep GoalTracking x -> GoalTracking
to :: forall x. Rep GoalTracking x -> GoalTracking
Generic, [GoalTracking] -> Value
[GoalTracking] -> Encoding
GoalTracking -> Bool
GoalTracking -> Value
GoalTracking -> Encoding
(GoalTracking -> Value)
-> (GoalTracking -> Encoding)
-> ([GoalTracking] -> Value)
-> ([GoalTracking] -> Encoding)
-> (GoalTracking -> Bool)
-> ToJSON GoalTracking
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: GoalTracking -> Value
toJSON :: GoalTracking -> Value
$ctoEncoding :: GoalTracking -> Encoding
toEncoding :: GoalTracking -> Encoding
$ctoJSONList :: [GoalTracking] -> Value
toJSONList :: [GoalTracking] -> Value
$ctoEncodingList :: [GoalTracking] -> Encoding
toEncodingList :: [GoalTracking] -> Encoding
$comitField :: GoalTracking -> Bool
omitField :: GoalTracking -> Bool
ToJSON)

instance ToSample GoalTracking where
  toSamples :: Proxy GoalTracking -> [(Text, GoalTracking)]
toSamples Proxy GoalTracking
_ =
    [GoalTracking] -> [(Text, GoalTracking)]
forall a. [a] -> [(Text, a)]
SD.samples
      [ [Announcement] -> CategorizedGoals -> GoalTracking
GoalTracking [Announcement]
forall a. Monoid a => a
mempty CategorizedGoals
forall a. Monoid a => a
mempty
      -- TODO: #1552 add simple objective sample
      ]

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

makeLenses ''GoalDisplay

emptyGoalDisplay :: GoalDisplay
emptyGoalDisplay :: GoalDisplay
emptyGoalDisplay =
  GoalTracking
-> List Name GoalEntry -> FocusRing Name -> GoalDisplay
GoalDisplay
    ([Announcement] -> CategorizedGoals -> GoalTracking
GoalTracking [Announcement]
forall a. Monoid a => a
mempty CategorizedGoals
forall a. Monoid a => a
mempty)
    (Name -> Vector GoalEntry -> Int -> List Name GoalEntry
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list (GoalWidget -> Name
GoalWidgets GoalWidget
ObjectivesList) Vector GoalEntry
forall a. Monoid a => a
mempty Int
1)
    ([Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing ([Name] -> FocusRing Name) -> [Name] -> FocusRing Name
forall a b. (a -> b) -> a -> b
$ (GoalWidget -> Name) -> [GoalWidget] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map GoalWidget -> Name
GoalWidgets [GoalWidget]
forall a. (Enum a, Bounded a) => [a]
enumerate)

hasAnythingToShow :: GoalTracking -> Bool
hasAnythingToShow :: GoalTracking -> Bool
hasAnythingToShow (GoalTracking [Announcement]
ann CategorizedGoals
g) = Bool -> Bool
not ([Announcement] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Announcement]
ann Bool -> Bool -> Bool
&& CategorizedGoals -> Bool
forall a. Map GoalStatus a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null CategorizedGoals
g)

hasMultipleGoals :: GoalTracking -> Bool
hasMultipleGoals :: GoalTracking -> Bool
hasMultipleGoals GoalTracking
gt =
  Int
goalCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
 where
  goalCount :: Int
goalCount = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (GoalTracking -> [Int]) -> GoalTracking -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map GoalStatus Int -> [Int]
forall k a. Map k a -> [a]
M.elems (Map GoalStatus Int -> [Int])
-> (GoalTracking -> Map GoalStatus Int) -> GoalTracking -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty Objective -> Int)
-> CategorizedGoals -> Map GoalStatus Int
forall a b k. (a -> b) -> Map k a -> Map k b
M.map NonEmpty Objective -> Int
forall a. NonEmpty a -> Int
NE.length (CategorizedGoals -> Map GoalStatus Int)
-> (GoalTracking -> CategorizedGoals)
-> GoalTracking
-> Map GoalStatus Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoalTracking -> CategorizedGoals
goals (GoalTracking -> Int) -> GoalTracking -> Int
forall a b. (a -> b) -> a -> b
$ GoalTracking
gt

constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap Bool
showHidden ObjectiveCompletion
oc =
  [(GoalStatus, NonEmpty Objective)] -> CategorizedGoals
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(GoalStatus, NonEmpty Objective)] -> CategorizedGoals)
-> [(GoalStatus, NonEmpty Objective)] -> CategorizedGoals
forall a b. (a -> b) -> a -> b
$
    ((GoalStatus, [Objective])
 -> Maybe (GoalStatus, NonEmpty Objective))
-> [(GoalStatus, [Objective])]
-> [(GoalStatus, NonEmpty Objective)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (([Objective] -> Maybe (NonEmpty Objective))
-> (GoalStatus, [Objective])
-> Maybe (GoalStatus, NonEmpty Objective)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (GoalStatus, a) -> f (GoalStatus, b)
traverse [Objective] -> Maybe (NonEmpty Objective)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty) [(GoalStatus, [Objective])]
categoryList
 where
  categoryList :: [(GoalStatus, [Objective])]
categoryList =
    [ (GoalStatus
Upcoming, [Objective]
displayableInactives)
    , (GoalStatus
Active, [Objective] -> [Objective]
suppressHidden [Objective]
activeGoals)
    , (GoalStatus
Completed, ObjectiveCompletion
oc ObjectiveCompletion
-> Getting (Endo [Objective]) ObjectiveCompletion Objective
-> [Objective]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Objective]) ObjectiveCompletion Objective
Fold ObjectiveCompletion Objective
completedObjectives)
    , (GoalStatus
Failed, ObjectiveCompletion
oc ObjectiveCompletion
-> Getting (Endo [Objective]) ObjectiveCompletion Objective
-> [Objective]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Getting (Endo [Objective]) ObjectiveCompletion Objective
Fold ObjectiveCompletion Objective
unwinnableObjectives)
    ]

  displayableInactives :: [Objective]
displayableInactives =
    [Objective] -> [Objective]
suppressHidden ([Objective] -> [Objective]) -> [Objective] -> [Objective]
forall a b. (a -> b) -> a -> b
$
      (Objective -> Bool) -> [Objective] -> [Objective]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool
-> (PrerequisiteConfig -> Bool) -> Maybe PrerequisiteConfig -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False PrerequisiteConfig -> Bool
previewable (Maybe PrerequisiteConfig -> Bool)
-> (Objective -> Maybe PrerequisiteConfig) -> Objective -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
-> Objective -> Maybe PrerequisiteConfig
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe PrerequisiteConfig) Objective (Maybe PrerequisiteConfig)
Lens' Objective (Maybe PrerequisiteConfig)
objectivePrerequisite) [Objective]
inactiveGoals

  suppressHidden :: [Objective] -> [Objective]
suppressHidden =
    Bool -> ([Objective] -> [Objective]) -> [Objective] -> [Objective]
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not Bool
showHidden) (([Objective] -> [Objective]) -> [Objective] -> [Objective])
-> ([Objective] -> [Objective]) -> [Objective] -> [Objective]
forall a b. (a -> b) -> a -> b
$ (Objective -> Bool) -> [Objective] -> [Objective]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Objective -> Bool) -> [Objective] -> [Objective])
-> (Objective -> Bool) -> [Objective] -> [Objective]
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Objective -> Bool) -> Objective -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Bool Objective Bool -> Objective -> Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Bool Objective Bool
Lens' Objective Bool
objectiveHidden

  ([Objective]
activeGoals, [Objective]
inactiveGoals) = ObjectiveCompletion -> ([Objective], [Objective])
partitionActiveObjectives ObjectiveCompletion
oc