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

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

-- | TODO: #1044 Could also add an "ObjectiveFailed" constructor...
newtype Announcement
  = ObjectiveCompleted Objective
  deriving (Int -> Announcement -> ShowS
[Announcement] -> ShowS
Announcement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Announcement] -> ShowS
$cshowList :: [Announcement] -> ShowS
show :: Announcement -> String
$cshow :: Announcement -> String
showsPrec :: Int -> Announcement -> ShowS
$cshowsPrec :: Int -> Announcement -> ShowS
Show, forall x. Rep Announcement x -> Announcement
forall x. Announcement -> Rep Announcement x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Announcement x -> Announcement
$cfrom :: forall x. Announcement -> Rep Announcement x
Generic, [Announcement] -> Encoding
[Announcement] -> Value
Announcement -> Encoding
Announcement -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Announcement] -> Encoding
$ctoEncodingList :: [Announcement] -> Encoding
toJSONList :: [Announcement] -> Value
$ctoJSONList :: [Announcement] -> Value
toEncoding :: Announcement -> Encoding
$ctoEncoding :: Announcement -> Encoding
toJSON :: Announcement -> Value
$ctoJSON :: Announcement -> Value
ToJSON)

type CategorizedGoals = Map GoalStatus (NonEmpty Objective)

data GoalEntry
  = Header GoalStatus
  | Goal GoalStatus Objective

isHeader :: GoalEntry -> Bool
isHeader :: GoalEntry -> Bool
isHeader = \case
  Header GoalStatus
_ -> Bool
True
  GoalEntry
_ -> Bool
False

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. 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
$cto :: forall x. Rep GoalTracking x -> GoalTracking
$cfrom :: forall x. GoalTracking -> Rep GoalTracking x
Generic, [GoalTracking] -> Encoding
[GoalTracking] -> Value
GoalTracking -> Encoding
GoalTracking -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GoalTracking] -> Encoding
$ctoEncodingList :: [GoalTracking] -> Encoding
toJSONList :: [GoalTracking] -> Value
$ctoJSONList :: [GoalTracking] -> Value
toEncoding :: GoalTracking -> Encoding
$ctoEncoding :: GoalTracking -> Encoding
toJSON :: GoalTracking -> Value
$ctoJSON :: GoalTracking -> Value
ToJSON)

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 forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty)
    (forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list (GoalWidget -> Name
GoalWidgets GoalWidget
ObjectivesList) forall a. Monoid a => a
mempty Int
1)
    (forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map GoalWidget -> Name
GoalWidgets forall e. (Enum e, Bounded e) => [e]
listEnums)

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

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

constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
constructGoalMap Bool
isCheating objectiveCompletion :: ObjectiveCompletion
objectiveCompletion@(ObjectiveCompletion CompletionBuckets
buckets Set ObjectiveLabel
_) =
  forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse 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, CompletionBuckets -> [Objective]
completed CompletionBuckets
buckets)
    , (GoalStatus
Failed, CompletionBuckets -> [Objective]
unwinnable CompletionBuckets
buckets)
    ]

  displayableInactives :: [Objective]
displayableInactives =
    [Objective] -> [Objective]
suppressHidden forall a b. (a -> b) -> a -> b
$
      forall a. (a -> Bool) -> [a] -> [a]
filter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False PrerequisiteConfig -> Bool
previewable forall b c a. (b -> c) -> (a -> b) -> a -> c
. Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite) [Objective]
inactiveGoals

  suppressHidden :: [Objective] -> [Objective]
suppressHidden =
    if Bool
isCheating
      then forall a. a -> a
id
      else forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Objective -> Bool
_objectiveHidden

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