{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
module Swarm.Game.Popup (
Popup (..),
PopupState,
currentPopup,
popupQueue,
initPopupState,
addPopup,
nextPopup,
) where
import Control.Lens (makeLenses, use, (%~), (.=))
import Control.Monad.State (MonadState)
import Data.Sequence (Seq, (|>), pattern (:<|))
import Data.Sequence qualified as Seq
import Swarm.Game.Achievement.Definitions (CategorizedAchievement)
import Swarm.Language.Syntax (Const)
data
= CategorizedAchievement
|
| CommandsPopup [Const]
|
data =
{ :: Maybe Popup
, :: Seq Popup
}
initPopupState :: PopupState
=
PopupState
{ _currentPopup :: Maybe Popup
_currentPopup = Maybe Popup
forall a. Maybe a
Nothing
, _popupQueue :: Seq Popup
_popupQueue = Seq Popup
forall a. Seq a
Seq.empty
}
addPopup :: Popup -> PopupState -> PopupState
Popup
notif = (Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Seq Popup)
popupQueue ((Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState)
-> (Seq Popup -> Seq Popup) -> PopupState -> PopupState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Seq Popup -> Popup -> Seq Popup
forall a. Seq a -> a -> Seq a
|> Popup
notif)
nextPopup :: MonadState PopupState m => m ()
= do
Seq Popup
q <- Getting (Seq Popup) PopupState (Seq Popup) -> m (Seq Popup)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Seq Popup) PopupState (Seq Popup)
Lens' PopupState (Seq Popup)
popupQueue
case Seq Popup
q of
Seq Popup
Seq.Empty -> (Maybe Popup -> Identity (Maybe Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Maybe Popup)
currentPopup ((Maybe Popup -> Identity (Maybe Popup))
-> PopupState -> Identity PopupState)
-> Maybe Popup -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Popup
forall a. Maybe a
Nothing
Popup
n :<| Seq Popup
ns -> do
(Maybe Popup -> Identity (Maybe Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Maybe Popup)
currentPopup ((Maybe Popup -> Identity (Maybe Popup))
-> PopupState -> Identity PopupState)
-> Maybe Popup -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Popup -> Maybe Popup
forall a. a -> Maybe a
Just Popup
n
(Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState
Lens' PopupState (Seq Popup)
popupQueue ((Seq Popup -> Identity (Seq Popup))
-> PopupState -> Identity PopupState)
-> Seq Popup -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Seq Popup
ns