{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Sum types that represent menu options,
-- modal dialogs, and buttons.
module Swarm.TUI.Model.Menu where

import Brick.Widgets.Dialog (Dialog)
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (from, (<.>))
import Data.List.Extra (enumerate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Text (Text)
import Data.Vector qualified as V
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Entity as E
import Swarm.Game.Ingredients
import Swarm.Game.ScenarioInfo (
  ScenarioCollection,
  ScenarioInfo (..),
  ScenarioInfoPair,
  ScenarioItem (..),
  scMap,
  scenarioCollectionToList,
 )
import Swarm.Game.World.Gen (Seed)
import Swarm.TUI.Model.Name
import System.FilePath (dropTrailingPathSeparator, splitPath, takeFileName)
import Witch (into)

------------------------------------------------------------
-- Menus and dialogs
------------------------------------------------------------

data ScenarioOutcome = WinModal | LoseModal
  deriving (Int -> ScenarioOutcome -> ShowS
[ScenarioOutcome] -> ShowS
ScenarioOutcome -> FilePath
(Int -> ScenarioOutcome -> ShowS)
-> (ScenarioOutcome -> FilePath)
-> ([ScenarioOutcome] -> ShowS)
-> Show ScenarioOutcome
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScenarioOutcome -> ShowS
showsPrec :: Int -> ScenarioOutcome -> ShowS
$cshow :: ScenarioOutcome -> FilePath
show :: ScenarioOutcome -> FilePath
$cshowList :: [ScenarioOutcome] -> ShowS
showList :: [ScenarioOutcome] -> ShowS
Show, ScenarioOutcome -> ScenarioOutcome -> Bool
(ScenarioOutcome -> ScenarioOutcome -> Bool)
-> (ScenarioOutcome -> ScenarioOutcome -> Bool)
-> Eq ScenarioOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScenarioOutcome -> ScenarioOutcome -> Bool
== :: ScenarioOutcome -> ScenarioOutcome -> Bool
$c/= :: ScenarioOutcome -> ScenarioOutcome -> Bool
/= :: ScenarioOutcome -> ScenarioOutcome -> Bool
Eq)

data ModalType
  = HelpModal
  | RecipesModal
  | CommandsModal
  | MessagesModal
  | StructuresModal
  | EntityPaletteModal
  | TerrainPaletteModal
  | RobotsModal
  | ScenarioEndModal ScenarioOutcome
  | QuitModal
  | KeepPlayingModal
  | DescriptionModal Entity
  | GoalModal
  deriving (Int -> ModalType -> ShowS
[ModalType] -> ShowS
ModalType -> FilePath
(Int -> ModalType -> ShowS)
-> (ModalType -> FilePath)
-> ([ModalType] -> ShowS)
-> Show ModalType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModalType -> ShowS
showsPrec :: Int -> ModalType -> ShowS
$cshow :: ModalType -> FilePath
show :: ModalType -> FilePath
$cshowList :: [ModalType] -> ShowS
showList :: [ModalType] -> ShowS
Show, ModalType -> ModalType -> Bool
(ModalType -> ModalType -> Bool)
-> (ModalType -> ModalType -> Bool) -> Eq ModalType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModalType -> ModalType -> Bool
== :: ModalType -> ModalType -> Bool
$c/= :: ModalType -> ModalType -> Bool
/= :: ModalType -> ModalType -> Bool
Eq)

data ButtonAction
  = Cancel
  | KeepPlaying
  | StartOver Seed ScenarioInfoPair
  | QuitAction
  | Next ScenarioInfoPair

data Modal = Modal
  { Modal -> ModalType
_modalType :: ModalType
  , Modal -> Dialog ButtonAction Name
_modalDialog :: Dialog ButtonAction Name
  }

makeLenses ''Modal

data MainMenuEntry
  = NewGame
  | Tutorial
  | Achievements
  | Messages
  | About
  | Quit
  deriving (MainMenuEntry -> MainMenuEntry -> Bool
(MainMenuEntry -> MainMenuEntry -> Bool)
-> (MainMenuEntry -> MainMenuEntry -> Bool) -> Eq MainMenuEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MainMenuEntry -> MainMenuEntry -> Bool
== :: MainMenuEntry -> MainMenuEntry -> Bool
$c/= :: MainMenuEntry -> MainMenuEntry -> Bool
/= :: MainMenuEntry -> MainMenuEntry -> Bool
Eq, Eq MainMenuEntry
Eq MainMenuEntry =>
(MainMenuEntry -> MainMenuEntry -> Ordering)
-> (MainMenuEntry -> MainMenuEntry -> Bool)
-> (MainMenuEntry -> MainMenuEntry -> Bool)
-> (MainMenuEntry -> MainMenuEntry -> Bool)
-> (MainMenuEntry -> MainMenuEntry -> Bool)
-> (MainMenuEntry -> MainMenuEntry -> MainMenuEntry)
-> (MainMenuEntry -> MainMenuEntry -> MainMenuEntry)
-> Ord MainMenuEntry
MainMenuEntry -> MainMenuEntry -> Bool
MainMenuEntry -> MainMenuEntry -> Ordering
MainMenuEntry -> MainMenuEntry -> MainMenuEntry
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 :: MainMenuEntry -> MainMenuEntry -> Ordering
compare :: MainMenuEntry -> MainMenuEntry -> Ordering
$c< :: MainMenuEntry -> MainMenuEntry -> Bool
< :: MainMenuEntry -> MainMenuEntry -> Bool
$c<= :: MainMenuEntry -> MainMenuEntry -> Bool
<= :: MainMenuEntry -> MainMenuEntry -> Bool
$c> :: MainMenuEntry -> MainMenuEntry -> Bool
> :: MainMenuEntry -> MainMenuEntry -> Bool
$c>= :: MainMenuEntry -> MainMenuEntry -> Bool
>= :: MainMenuEntry -> MainMenuEntry -> Bool
$cmax :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
max :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
$cmin :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
min :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry
Ord, Int -> MainMenuEntry -> ShowS
[MainMenuEntry] -> ShowS
MainMenuEntry -> FilePath
(Int -> MainMenuEntry -> ShowS)
-> (MainMenuEntry -> FilePath)
-> ([MainMenuEntry] -> ShowS)
-> Show MainMenuEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MainMenuEntry -> ShowS
showsPrec :: Int -> MainMenuEntry -> ShowS
$cshow :: MainMenuEntry -> FilePath
show :: MainMenuEntry -> FilePath
$cshowList :: [MainMenuEntry] -> ShowS
showList :: [MainMenuEntry] -> ShowS
Show, ReadPrec [MainMenuEntry]
ReadPrec MainMenuEntry
Int -> ReadS MainMenuEntry
ReadS [MainMenuEntry]
(Int -> ReadS MainMenuEntry)
-> ReadS [MainMenuEntry]
-> ReadPrec MainMenuEntry
-> ReadPrec [MainMenuEntry]
-> Read MainMenuEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MainMenuEntry
readsPrec :: Int -> ReadS MainMenuEntry
$creadList :: ReadS [MainMenuEntry]
readList :: ReadS [MainMenuEntry]
$creadPrec :: ReadPrec MainMenuEntry
readPrec :: ReadPrec MainMenuEntry
$creadListPrec :: ReadPrec [MainMenuEntry]
readListPrec :: ReadPrec [MainMenuEntry]
Read, MainMenuEntry
MainMenuEntry -> MainMenuEntry -> Bounded MainMenuEntry
forall a. a -> a -> Bounded a
$cminBound :: MainMenuEntry
minBound :: MainMenuEntry
$cmaxBound :: MainMenuEntry
maxBound :: MainMenuEntry
Bounded, Int -> MainMenuEntry
MainMenuEntry -> Int
MainMenuEntry -> [MainMenuEntry]
MainMenuEntry -> MainMenuEntry
MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
(MainMenuEntry -> MainMenuEntry)
-> (MainMenuEntry -> MainMenuEntry)
-> (Int -> MainMenuEntry)
-> (MainMenuEntry -> Int)
-> (MainMenuEntry -> [MainMenuEntry])
-> (MainMenuEntry -> MainMenuEntry -> [MainMenuEntry])
-> (MainMenuEntry -> MainMenuEntry -> [MainMenuEntry])
-> (MainMenuEntry
    -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry])
-> Enum MainMenuEntry
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 :: MainMenuEntry -> MainMenuEntry
succ :: MainMenuEntry -> MainMenuEntry
$cpred :: MainMenuEntry -> MainMenuEntry
pred :: MainMenuEntry -> MainMenuEntry
$ctoEnum :: Int -> MainMenuEntry
toEnum :: Int -> MainMenuEntry
$cfromEnum :: MainMenuEntry -> Int
fromEnum :: MainMenuEntry -> Int
$cenumFrom :: MainMenuEntry -> [MainMenuEntry]
enumFrom :: MainMenuEntry -> [MainMenuEntry]
$cenumFromThen :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFromThen :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
$cenumFromTo :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFromTo :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
$cenumFromThenTo :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
enumFromThenTo :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry]
Enum)

data Menu
  = -- | We started playing directly from command line, no menu to show
    NoMenu
  | MainMenu (BL.List Name MainMenuEntry)
  | -- | Stack of scenario item lists. INVARIANT: the currently selected
    -- menu item is ALWAYS the same as the scenario currently being played.
    -- See https://github.com/swarm-game/swarm/issues/1064 and
    -- https://github.com/swarm-game/swarm/pull/1065.
    NewGameMenu (NonEmpty (BL.List Name ScenarioItem))
  | AchievementsMenu (BL.List Name CategorizedAchievement)
  | MessagesMenu
  | AboutMenu

mainMenu :: MainMenuEntry -> BL.List Name MainMenuEntry
mainMenu :: MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
e = Name -> Vector MainMenuEntry -> Int -> List Name MainMenuEntry
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
MenuList ([MainMenuEntry] -> Vector MainMenuEntry
forall a. [a] -> Vector a
V.fromList [MainMenuEntry]
forall a. (Enum a, Bounded a) => [a]
enumerate) Int
1 List Name MainMenuEntry
-> (List Name MainMenuEntry -> List Name MainMenuEntry)
-> List Name MainMenuEntry
forall a b. a -> (a -> b) -> b
& MainMenuEntry -> List Name MainMenuEntry -> List Name MainMenuEntry
forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
BL.listMoveToElement MainMenuEntry
e

makePrisms ''Menu

-- | Create a brick 'BL.List' of scenario items from a 'ScenarioCollection'.
mkScenarioList :: Bool -> ScenarioCollection -> BL.List Name ScenarioItem
mkScenarioList :: Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat = (Vector ScenarioItem -> Int -> List Name ScenarioItem)
-> Int -> Vector ScenarioItem -> List Name ScenarioItem
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Name -> Vector ScenarioItem -> Int -> List Name ScenarioItem
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
ScenarioList) Int
1 (Vector ScenarioItem -> List Name ScenarioItem)
-> (ScenarioCollection -> Vector ScenarioItem)
-> ScenarioCollection
-> List Name ScenarioItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScenarioItem] -> Vector ScenarioItem
forall a. [a] -> Vector a
V.fromList ([ScenarioItem] -> Vector ScenarioItem)
-> (ScenarioCollection -> [ScenarioItem])
-> ScenarioCollection
-> Vector ScenarioItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ScenarioItem] -> [ScenarioItem]
filterTest ([ScenarioItem] -> [ScenarioItem])
-> (ScenarioCollection -> [ScenarioItem])
-> ScenarioCollection
-> [ScenarioItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScenarioCollection -> [ScenarioItem]
scenarioCollectionToList
 where
  filterTest :: [ScenarioItem] -> [ScenarioItem]
filterTest = if Bool
cheat then [ScenarioItem] -> [ScenarioItem]
forall a. a -> a
id else (ScenarioItem -> Bool) -> [ScenarioItem] -> [ScenarioItem]
forall a. (a -> Bool) -> [a] -> [a]
filter (\case SICollection Text
n ScenarioCollection
_ -> Text
n Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"Testing"; ScenarioItem
_ -> Bool
True)

-- | Given a 'ScenarioCollection' and a 'FilePath' which is the canonical
--   path to some folder or scenario, construct a 'NewGameMenu' stack
--   focused on the given item, if possible.
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu Bool
cheat ScenarioCollection
sc FilePath
path = (NonEmpty (List Name ScenarioItem) -> Menu)
-> Maybe (NonEmpty (List Name ScenarioItem)) -> Maybe Menu
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty (List Name ScenarioItem) -> Menu
NewGameMenu (Maybe (NonEmpty (List Name ScenarioItem)) -> Maybe Menu)
-> Maybe (NonEmpty (List Name ScenarioItem)) -> Maybe Menu
forall a b. (a -> b) -> a -> b
$ [List Name ScenarioItem]
-> Maybe (NonEmpty (List Name ScenarioItem))
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty ([List Name ScenarioItem]
 -> Maybe (NonEmpty (List Name ScenarioItem)))
-> Maybe [List Name ScenarioItem]
-> Maybe (NonEmpty (List Name ScenarioItem))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go (ScenarioCollection -> Maybe ScenarioCollection
forall a. a -> Maybe a
Just ScenarioCollection
sc) (FilePath -> [FilePath]
splitPath FilePath
path) []
 where
  go ::
    Maybe ScenarioCollection ->
    [FilePath] ->
    [BL.List Name ScenarioItem] ->
    Maybe [BL.List Name ScenarioItem]
  go :: Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go Maybe ScenarioCollection
_ [] [List Name ScenarioItem]
stk = [List Name ScenarioItem] -> Maybe [List Name ScenarioItem]
forall a. a -> Maybe a
Just [List Name ScenarioItem]
stk
  go Maybe ScenarioCollection
Nothing [FilePath]
_ [List Name ScenarioItem]
_ = Maybe [List Name ScenarioItem]
forall a. Maybe a
Nothing
  go (Just ScenarioCollection
curSC) (FilePath
thing : [FilePath]
rest) [List Name ScenarioItem]
stk = Maybe ScenarioCollection
-> [FilePath]
-> [List Name ScenarioItem]
-> Maybe [List Name ScenarioItem]
go Maybe ScenarioCollection
nextSC [FilePath]
rest (List Name ScenarioItem
lst List Name ScenarioItem
-> [List Name ScenarioItem] -> [List Name ScenarioItem]
forall a. a -> [a] -> [a]
: [List Name ScenarioItem]
stk)
   where
    hasName :: ScenarioItem -> Bool
    hasName :: ScenarioItem -> Bool
hasName (SISingle (Scenario
_, ScenarioInfo FilePath
pth ScenarioStatus
_)) = ShowS
takeFileName FilePath
pth FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
thing
    hasName (SICollection Text
nm ScenarioCollection
_) = Text
nm Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== forall target source. From source target => source -> target
into @Text (ShowS
dropTrailingPathSeparator FilePath
thing)

    lst :: List Name ScenarioItem
lst = (ScenarioItem -> Bool)
-> List Name ScenarioItem -> List Name ScenarioItem
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
BL.listFindBy ScenarioItem -> Bool
hasName (Bool -> ScenarioCollection -> List Name ScenarioItem
mkScenarioList Bool
cheat ScenarioCollection
curSC)

    nextSC :: Maybe ScenarioCollection
nextSC = case FilePath -> Map FilePath ScenarioItem -> Maybe ScenarioItem
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (ShowS
dropTrailingPathSeparator FilePath
thing) (ScenarioCollection -> Map FilePath ScenarioItem
scMap ScenarioCollection
curSC) of
      Just (SICollection Text
_ ScenarioCollection
c) -> ScenarioCollection -> Maybe ScenarioCollection
forall a. a -> Maybe a
Just ScenarioCollection
c
      Maybe ScenarioItem
_ -> Maybe ScenarioCollection
forall a. Maybe a
Nothing

------------------------------------------------------------
-- Inventory list entries
------------------------------------------------------------

-- | An entry in the inventory list displayed in the info panel.  We
--   can either have an entity with a count in the robot's inventory,
--   an entity equipped on the robot, or a labelled separator.  The
--   purpose of the separators is to show a clear distinction between
--   the robot's /inventory/ and its /equipped devices/.
data InventoryListEntry
  = Separator Text
  | InventoryEntry Count Entity
  | EquippedEntry Entity
  deriving (InventoryListEntry -> InventoryListEntry -> Bool
(InventoryListEntry -> InventoryListEntry -> Bool)
-> (InventoryListEntry -> InventoryListEntry -> Bool)
-> Eq InventoryListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InventoryListEntry -> InventoryListEntry -> Bool
== :: InventoryListEntry -> InventoryListEntry -> Bool
$c/= :: InventoryListEntry -> InventoryListEntry -> Bool
/= :: InventoryListEntry -> InventoryListEntry -> Bool
Eq)

makePrisms ''InventoryListEntry