{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Display logic for Objectives.
module Swarm.TUI.View.Objective where

import Brick hiding (Direction, Location)
import Brick.Focus
import Brick.Widgets.Center
import Brick.Widgets.List qualified as BL
import Control.Applicative ((<|>))
import Control.Lens hiding (Const, from)
import Data.List (intercalate)
import Data.List.NonEmpty qualified as NE
import Data.Map.Strict qualified as M
import Data.Vector qualified as V
import Swarm.Game.Scenario.Objective
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Text.Markdown (Document)
import Swarm.Language.Text.Markdown qualified as Markdown
import Swarm.TUI.Model.Dialog.Goal
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr
import Swarm.TUI.View.Util
import Swarm.Util (applyWhen)

makeListWidget :: GoalTracking -> BL.List Name GoalEntry
makeListWidget :: GoalTracking -> List Name GoalEntry
makeListWidget (GoalTracking [Announcement]
_announcements CategorizedGoals
categorizedObjs) =
  Int -> List Name GoalEntry -> List Name GoalEntry
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
1 (List Name GoalEntry -> List Name GoalEntry)
-> List Name GoalEntry -> List Name GoalEntry
forall a b. (a -> b) -> a -> b
$ 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) ([GoalEntry] -> Vector GoalEntry
forall a. [a] -> Vector a
V.fromList [GoalEntry]
objList) Int
1
 where
  objList :: [GoalEntry]
objList = [GoalEntry] -> [[GoalEntry]] -> [GoalEntry]
forall a. [a] -> [[a]] -> [a]
intercalate [GoalEntry
Spacer] ([[GoalEntry]] -> [GoalEntry]) -> [[GoalEntry]] -> [GoalEntry]
forall a b. (a -> b) -> a -> b
$ ((GoalStatus, NonEmpty Objective) -> [GoalEntry])
-> [(GoalStatus, NonEmpty Objective)] -> [[GoalEntry]]
forall a b. (a -> b) -> [a] -> [b]
map (GoalStatus, NonEmpty Objective) -> [GoalEntry]
f ([(GoalStatus, NonEmpty Objective)] -> [[GoalEntry]])
-> [(GoalStatus, NonEmpty Objective)] -> [[GoalEntry]]
forall a b. (a -> b) -> a -> b
$ CategorizedGoals -> [(GoalStatus, NonEmpty Objective)]
forall k a. Map k a -> [(k, a)]
M.toList CategorizedGoals
categorizedObjs
  f :: (GoalStatus, NonEmpty Objective) -> [GoalEntry]
f (GoalStatus
h, NonEmpty Objective
xs) = GoalStatus -> GoalEntry
Header GoalStatus
h GoalEntry -> [GoalEntry] -> [GoalEntry]
forall a. a -> [a] -> [a]
: (Objective -> GoalEntry) -> [Objective] -> [GoalEntry]
forall a b. (a -> b) -> [a] -> [b]
map (GoalStatus -> Objective -> GoalEntry
Goal GoalStatus
h) (NonEmpty Objective -> [Objective]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Objective
xs)

renderGoalsDisplay :: GoalDisplay -> Maybe (Document Syntax) -> Widget Name
renderGoalsDisplay :: GoalDisplay -> Maybe (Document Syntax) -> Widget Name
renderGoalsDisplay GoalDisplay
gd Maybe (Document Syntax)
desc =
  [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
    [ Widget Name
-> (Document Syntax -> Widget Name)
-> Maybe (Document Syntax)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name)
-> (Document Syntax -> Widget Name)
-> Document Syntax
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padTop (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> (Document Syntax -> Widget Name)
-> Document Syntax
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget Name -> Widget Name)
-> (Document Syntax -> Widget Name)
-> Document Syntax
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document Syntax -> Widget Name
drawMarkdown) Maybe (Document Syntax)
desc
    , Widget Name
goalsWidget
    ]
 where
  goalsWidget :: Widget Name
goalsWidget
    | Bool
hasMultiple =
        [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
          [ [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox
              [ Widget Name
leftSide
              , Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padLeft (Int -> Padding
Pad Int
2) Widget Name
goalElaboration
              ]
          , Widget Name
forall n. Widget n
footer
          ]
    | Bool
otherwise = Widget Name
goalElaboration

  footer :: Widget n
footer = Widget n -> Widget n
forall n. Widget n -> Widget n
hCenter (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
italicAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"NOTE: [Tab] toggles focus between panes"
  hasMultiple :: Bool
hasMultiple = GoalTracking -> Bool
hasMultipleGoals (GoalTracking -> Bool) -> GoalTracking -> Bool
forall a b. (a -> b) -> a -> b
$ GoalDisplay
gd GoalDisplay
-> Getting GoalTracking GoalDisplay GoalTracking -> GoalTracking
forall s a. s -> Getting a s a -> a
^. Getting GoalTracking GoalDisplay GoalTracking
Lens' GoalDisplay GoalTracking
goalsContent
  lw :: List Name GoalEntry
lw = GoalDisplay -> List Name GoalEntry
_listWidget GoalDisplay
gd
  fr :: FocusRing Name
fr = GoalDisplay -> FocusRing Name
_focus GoalDisplay
gd
  leftSide :: Widget Name
leftSide =
    Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
hLimitPercent Int
30 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
      Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
        [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
          [ Widget Name -> Widget Name
forall n. Widget n -> Widget n
hCenter (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str String
"Goals"
          , Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
              Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
10 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                FocusRing Name
-> (Bool -> List Name GoalEntry -> Widget Name)
-> List Name GoalEntry
-> Widget Name
forall n a b.
(Eq n, Named a n) =>
FocusRing n -> (Bool -> a -> b) -> a -> b
withFocusRing FocusRing Name
fr ((Bool -> GoalEntry -> Widget Name)
-> Bool -> List Name GoalEntry -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
BL.renderList Bool -> GoalEntry -> Widget Name
drawGoalListItem) List Name GoalEntry
lw
          ]

  -- Adds very subtle coloring to indicate focus switch
  highlightIfFocused :: Widget n -> Widget n
highlightIfFocused = case (Bool
hasMultiple, FocusRing Name -> Maybe Name
forall n. FocusRing n -> Maybe n
focusGetCurrent FocusRing Name
fr) of
    (Bool
True, Just (GoalWidgets GoalWidget
GoalSummary)) -> AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
lightCyanAttr
    (Bool, Maybe Name)
_ -> Widget n -> Widget n
forall a. a -> a
id

  -- Note: An extra "padRight" is inserted to account for the vertical scrollbar,
  -- whether or not it appears.
  goalElaboration :: Widget Name
goalElaboration =
    Name -> Widget Name -> Widget Name
forall n. Ord n => n -> Widget n -> Widget n
clickable (GoalWidget -> Name
GoalWidgets GoalWidget
GoalSummary)
      (Widget Name -> Widget Name)
-> (Maybe (Int, GoalEntry) -> Widget Name)
-> Maybe (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Widget Name -> Widget Name
forall n. (Ord n, Show n) => n -> Widget n -> Widget n
maybeScroll Name
ModalViewport
      (Widget Name -> Widget Name)
-> (Maybe (Int, GoalEntry) -> Widget Name)
-> Maybe (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name
-> ((Int, GoalEntry) -> Widget Name)
-> Maybe (Int, GoalEntry)
-> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Widget Name
forall n. Widget n
emptyWidget (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
padAll Int
1 (Widget Name -> Widget Name)
-> ((Int, GoalEntry) -> Widget Name)
-> (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Padding -> Widget Name -> Widget Name
forall n. Padding -> Widget n -> Widget n
padRight (Int -> Padding
Pad Int
1) (Widget Name -> Widget Name)
-> ((Int, GoalEntry) -> Widget Name)
-> (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget Name -> Widget Name
forall n. Widget n -> Widget n
highlightIfFocused (Widget Name -> Widget Name)
-> ((Int, GoalEntry) -> Widget Name)
-> (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GoalEntry -> Widget Name
singleGoalDetails (GoalEntry -> Widget Name)
-> ((Int, GoalEntry) -> GoalEntry)
-> (Int, GoalEntry)
-> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, GoalEntry) -> GoalEntry
forall a b. (a, b) -> b
snd)
      (Maybe (Int, GoalEntry) -> Widget Name)
-> Maybe (Int, GoalEntry) -> Widget Name
forall a b. (a -> b) -> a -> b
$ List Name GoalEntry -> Maybe (Int, GoalEntry)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement List Name GoalEntry
lw

getCompletionIcon :: Objective -> GoalStatus -> Widget Name
getCompletionIcon :: Objective -> GoalStatus -> Widget Name
getCompletionIcon Objective
obj = \case
  GoalStatus
Upcoming -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
yellowAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ○  "
  GoalStatus
Active -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
cyanAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ○  "
  GoalStatus
Failed -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
redAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ●  "
  GoalStatus
Completed -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
colorAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Text -> Widget Name
forall n. Text -> Widget n
txt Text
" ●  "
   where
    colorAttr :: AttrName
colorAttr =
      if Objective
obj Objective -> Getting Bool Objective Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Objective Bool
Lens' Objective Bool
objectiveHidden
        then AttrName
magentaAttr
        else AttrName
greenAttr

drawGoalListItem ::
  Bool ->
  GoalEntry ->
  Widget Name
drawGoalListItem :: Bool -> GoalEntry -> Widget Name
drawGoalListItem Bool
_isSelected GoalEntry
e = case GoalEntry
e of
  GoalEntry
Spacer -> String -> Widget Name
forall n. String -> Widget n
str String
" "
  Header GoalStatus
gs -> AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
boldAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ String -> Widget Name
forall n. String -> Widget n
str (String -> Widget Name) -> String -> Widget Name
forall a b. (a -> b) -> a -> b
$ GoalStatus -> String
forall a. Show a => a -> String
show GoalStatus
gs
  Goal GoalStatus
gs Objective
obj -> Objective -> GoalStatus -> Widget Name
getCompletionIcon Objective
obj GoalStatus
gs Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Widget Name
titleWidget
   where
    textSource :: Maybe Text
textSource = Objective
obj Objective
-> Getting (Maybe Text) Objective (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Objective (Maybe Text)
Lens' Objective (Maybe Text)
objectiveTeaser Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Objective
obj Objective
-> Getting (Maybe Text) Objective (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Text) Objective (Maybe Text)
Lens' Objective (Maybe Text)
objectiveId Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Maybe Text
forall a. a -> Maybe a
Just (Document Syntax -> Text
forall a. PrettyPrec a => Document a -> Text
Markdown.docToText (Document Syntax -> Text) -> Document Syntax -> Text
forall a b. (a -> b) -> a -> b
$ Objective
obj Objective
-> Getting (Document Syntax) Objective (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. Getting (Document Syntax) Objective (Document Syntax)
Lens' Objective (Document Syntax)
objectiveGoal)
    titleWidget :: Widget Name
titleWidget = Widget Name -> (Text -> Widget Name) -> Maybe Text -> Widget Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"?") (Widget Name -> Widget Name
forall n. Widget n -> Widget n
titleColor (Widget Name -> Widget Name)
-> (Text -> Widget Name) -> Text -> Widget Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EllipsisSide -> Text -> Widget Name
withEllipsis EllipsisSide
End) Maybe Text
textSource
    titleColor :: Widget n -> Widget n
titleColor = Bool -> (Widget n -> Widget n) -> Widget n -> Widget n
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Objective
obj Objective -> Getting Bool Objective Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Objective Bool
Lens' Objective Bool
objectiveOptional) ((Widget n -> Widget n) -> Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
grayAttr

singleGoalDetails :: GoalEntry -> Widget Name
singleGoalDetails :: GoalEntry -> Widget Name
singleGoalDetails = \case
  Goal GoalStatus
_gs Objective
obj ->
    [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
vBox
      [ Widget Name
forall n. Widget n
optionalIndicator
      , Document Syntax -> Widget Name
drawMarkdown (Document Syntax -> Widget Name) -> Document Syntax -> Widget Name
forall a b. (a -> b) -> a -> b
$ Objective
obj Objective
-> Getting (Document Syntax) Objective (Document Syntax)
-> Document Syntax
forall s a. s -> Getting a s a -> a
^. Getting (Document Syntax) Objective (Document Syntax)
Lens' Objective (Document Syntax)
objectiveGoal
      ]
   where
    optionalIndicator :: Widget n
optionalIndicator =
      if Objective
obj Objective -> Getting Bool Objective Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool Objective Bool
Lens' Objective Bool
objectiveOptional
        then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withAttr AttrName
grayAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt Text
"[Optional]"
        else Widget n
forall n. Widget n
emptyWidget
  -- Only Goal entries are selectable, so we should never see this:
  GoalEntry
_ -> Widget Name
forall n. Widget n
emptyWidget