{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Swarm.Game.Scenario.Objective where
import Control.Applicative ((<|>))
import Control.Lens hiding (from, (<.>))
import Data.Aeson
import Data.Set qualified as Set
import Data.Text (Text)
import GHC.Generics (Generic)
import Swarm.Game.Scenario.Objective.Logic as L
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.TUI.Model.Achievement.Definitions
import Swarm.Util (reflow)
data PrerequisiteConfig = PrerequisiteConfig
{ PrerequisiteConfig -> Bool
previewable :: Bool
, PrerequisiteConfig -> Prerequisite Text
logic :: Prerequisite ObjectiveLabel
}
deriving (PrerequisiteConfig -> PrerequisiteConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
$c/= :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
== :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
$c== :: PrerequisiteConfig -> PrerequisiteConfig -> Bool
Eq, Int -> PrerequisiteConfig -> ShowS
[PrerequisiteConfig] -> ShowS
PrerequisiteConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PrerequisiteConfig] -> ShowS
$cshowList :: [PrerequisiteConfig] -> ShowS
show :: PrerequisiteConfig -> String
$cshow :: PrerequisiteConfig -> String
showsPrec :: Int -> PrerequisiteConfig -> ShowS
$cshowsPrec :: Int -> PrerequisiteConfig -> ShowS
Show, forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig
forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PrerequisiteConfig x -> PrerequisiteConfig
$cfrom :: forall x. PrerequisiteConfig -> Rep PrerequisiteConfig x
Generic, [PrerequisiteConfig] -> Encoding
[PrerequisiteConfig] -> Value
PrerequisiteConfig -> Encoding
PrerequisiteConfig -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PrerequisiteConfig] -> Encoding
$ctoEncodingList :: [PrerequisiteConfig] -> Encoding
toJSONList :: [PrerequisiteConfig] -> Value
$ctoJSONList :: [PrerequisiteConfig] -> Value
toEncoding :: PrerequisiteConfig -> Encoding
$ctoEncoding :: PrerequisiteConfig -> Encoding
toJSON :: PrerequisiteConfig -> Value
$ctoJSON :: PrerequisiteConfig -> Value
ToJSON)
instance FromJSON PrerequisiteConfig where
parseJSON :: Value -> Parser PrerequisiteConfig
parseJSON Value
val = Value -> Parser PrerequisiteConfig
preLogic Value
val forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser PrerequisiteConfig
preObject Value
val
where
preObject :: Value -> Parser PrerequisiteConfig
preObject = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"prerequisite" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Bool -> Prerequisite Text -> PrerequisiteConfig
PrerequisiteConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previewable" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"logic"
preLogic :: Value -> Parser PrerequisiteConfig
preLogic = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Prerequisite Text -> PrerequisiteConfig
PrerequisiteConfig Bool
False) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON
data Objective = Objective
{ Objective -> [Text]
_objectiveGoal :: [Text]
, Objective -> Maybe Text
_objectiveTeaser :: Maybe Text
, Objective -> ProcessedTerm
_objectiveCondition :: ProcessedTerm
, Objective -> Maybe Text
_objectiveId :: Maybe ObjectiveLabel
, Objective -> Bool
_objectiveOptional :: Bool
, Objective -> Maybe PrerequisiteConfig
_objectivePrerequisite :: Maybe PrerequisiteConfig
, Objective -> Bool
_objectiveHidden :: Bool
, Objective -> Maybe AchievementInfo
_objectiveAchievement :: Maybe AchievementInfo
}
deriving (Objective -> Objective -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Objective -> Objective -> Bool
$c/= :: Objective -> Objective -> Bool
== :: Objective -> Objective -> Bool
$c== :: Objective -> Objective -> Bool
Eq, Int -> Objective -> ShowS
[Objective] -> ShowS
Objective -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Objective] -> ShowS
$cshowList :: [Objective] -> ShowS
show :: Objective -> String
$cshow :: Objective -> String
showsPrec :: Int -> Objective -> ShowS
$cshowsPrec :: Int -> Objective -> ShowS
Show, forall x. Rep Objective x -> Objective
forall x. Objective -> Rep Objective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Objective x -> Objective
$cfrom :: forall x. Objective -> Rep Objective x
Generic, [Objective] -> Encoding
[Objective] -> Value
Objective -> Encoding
Objective -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Objective] -> Encoding
$ctoEncodingList :: [Objective] -> Encoding
toJSONList :: [Objective] -> Value
$ctoJSONList :: [Objective] -> Value
toEncoding :: Objective -> Encoding
$ctoEncoding :: Objective -> Encoding
toJSON :: Objective -> Value
$ctoJSON :: Objective -> Value
ToJSON)
makeLensesWith (lensRules & generateSignatures .~ False) ''Objective
objectiveGoal :: Lens' Objective [Text]
objectiveTeaser :: Lens' Objective (Maybe Text)
objectiveCondition :: Lens' Objective ProcessedTerm
objectiveId :: Lens' Objective (Maybe Text)
objectiveOptional :: Lens' Objective Bool
objectivePrerequisite :: Lens' Objective (Maybe PrerequisiteConfig)
objectiveHidden :: Lens' Objective Bool
objectiveAchievement :: Lens' Objective (Maybe AchievementInfo)
instance FromJSON Objective where
parseJSON :: Value -> Parser Objective
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"objective" forall a b. (a -> b) -> a -> b
$ \Object
v ->
[Text]
-> Maybe Text
-> ProcessedTerm
-> Maybe Text
-> Bool
-> Maybe PrerequisiteConfig
-> Bool
-> Maybe AchievementInfo
-> Objective
Objective
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) Text -> Text
reflow (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"goal" forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"teaser")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"condition")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"optional" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prerequisite")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hidden" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"achievement")
data CompletionBuckets = CompletionBuckets
{ CompletionBuckets -> [Objective]
incomplete :: [Objective]
, CompletionBuckets -> [Objective]
completed :: [Objective]
, CompletionBuckets -> [Objective]
unwinnable :: [Objective]
}
deriving (Int -> CompletionBuckets -> ShowS
[CompletionBuckets] -> ShowS
CompletionBuckets -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionBuckets] -> ShowS
$cshowList :: [CompletionBuckets] -> ShowS
show :: CompletionBuckets -> String
$cshow :: CompletionBuckets -> String
showsPrec :: Int -> CompletionBuckets -> ShowS
$cshowsPrec :: Int -> CompletionBuckets -> ShowS
Show, forall x. Rep CompletionBuckets x -> CompletionBuckets
forall x. CompletionBuckets -> Rep CompletionBuckets x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompletionBuckets x -> CompletionBuckets
$cfrom :: forall x. CompletionBuckets -> Rep CompletionBuckets x
Generic, Value -> Parser [CompletionBuckets]
Value -> Parser CompletionBuckets
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CompletionBuckets]
$cparseJSONList :: Value -> Parser [CompletionBuckets]
parseJSON :: Value -> Parser CompletionBuckets
$cparseJSON :: Value -> Parser CompletionBuckets
FromJSON, [CompletionBuckets] -> Encoding
[CompletionBuckets] -> Value
CompletionBuckets -> Encoding
CompletionBuckets -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CompletionBuckets] -> Encoding
$ctoEncodingList :: [CompletionBuckets] -> Encoding
toJSONList :: [CompletionBuckets] -> Value
$ctoJSONList :: [CompletionBuckets] -> Value
toEncoding :: CompletionBuckets -> Encoding
$ctoEncoding :: CompletionBuckets -> Encoding
toJSON :: CompletionBuckets -> Value
$ctoJSON :: CompletionBuckets -> Value
ToJSON)
data ObjectiveCompletion = ObjectiveCompletion
{ ObjectiveCompletion -> CompletionBuckets
completionBuckets :: CompletionBuckets
, ObjectiveCompletion -> Set Text
completedIDs :: Set.Set ObjectiveLabel
}
deriving (Int -> ObjectiveCompletion -> ShowS
[ObjectiveCompletion] -> ShowS
ObjectiveCompletion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ObjectiveCompletion] -> ShowS
$cshowList :: [ObjectiveCompletion] -> ShowS
show :: ObjectiveCompletion -> String
$cshow :: ObjectiveCompletion -> String
showsPrec :: Int -> ObjectiveCompletion -> ShowS
$cshowsPrec :: Int -> ObjectiveCompletion -> ShowS
Show, forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion
forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ObjectiveCompletion x -> ObjectiveCompletion
$cfrom :: forall x. ObjectiveCompletion -> Rep ObjectiveCompletion x
Generic, Value -> Parser [ObjectiveCompletion]
Value -> Parser ObjectiveCompletion
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ObjectiveCompletion]
$cparseJSONList :: Value -> Parser [ObjectiveCompletion]
parseJSON :: Value -> Parser ObjectiveCompletion
$cparseJSON :: Value -> Parser ObjectiveCompletion
FromJSON, [ObjectiveCompletion] -> Encoding
[ObjectiveCompletion] -> Value
ObjectiveCompletion -> Encoding
ObjectiveCompletion -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ObjectiveCompletion] -> Encoding
$ctoEncodingList :: [ObjectiveCompletion] -> Encoding
toJSONList :: [ObjectiveCompletion] -> Value
$ctoJSONList :: [ObjectiveCompletion] -> Value
toEncoding :: ObjectiveCompletion -> Encoding
$ctoEncoding :: ObjectiveCompletion -> Encoding
toJSON :: ObjectiveCompletion -> Value
$ctoJSON :: ObjectiveCompletion -> Value
ToJSON)
listAllObjectives :: CompletionBuckets -> [Objective]
listAllObjectives :: CompletionBuckets -> [Objective]
listAllObjectives (CompletionBuckets [Objective]
x [Objective]
y [Objective]
z) = [Objective]
x forall a. Semigroup a => a -> a -> a
<> [Objective]
y forall a. Semigroup a => a -> a -> a
<> [Objective]
z
addCompleted :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addCompleted :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addCompleted Objective
obj (ObjectiveCompletion CompletionBuckets
buckets Set Text
cmplIds) =
CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion CompletionBuckets
newBuckets Set Text
newCmplById
where
newBuckets :: CompletionBuckets
newBuckets =
CompletionBuckets
buckets
{ completed :: [Objective]
completed = Objective
obj forall a. a -> [a] -> [a]
: CompletionBuckets -> [Objective]
completed CompletionBuckets
buckets
}
newCmplById :: Set Text
newCmplById = case Objective -> Maybe Text
_objectiveId Objective
obj of
Maybe Text
Nothing -> Set Text
cmplIds
Just Text
lbl -> forall a. Ord a => a -> Set a -> Set a
Set.insert Text
lbl Set Text
cmplIds
addUnwinnable :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addUnwinnable :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addUnwinnable Objective
obj (ObjectiveCompletion CompletionBuckets
buckets Set Text
cmplIds) =
CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion CompletionBuckets
newBuckets Set Text
cmplIds
where
newBuckets :: CompletionBuckets
newBuckets =
CompletionBuckets
buckets
{ unwinnable :: [Objective]
unwinnable = Objective
obj forall a. a -> [a] -> [a]
: CompletionBuckets -> [Objective]
unwinnable CompletionBuckets
buckets
}
setIncomplete ::
([Objective] -> [Objective]) ->
ObjectiveCompletion ->
ObjectiveCompletion
setIncomplete :: ([Objective] -> [Objective])
-> ObjectiveCompletion -> ObjectiveCompletion
setIncomplete [Objective] -> [Objective]
f (ObjectiveCompletion CompletionBuckets
buckets Set Text
cmplIds) =
CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion CompletionBuckets
newBuckets Set Text
cmplIds
where
newBuckets :: CompletionBuckets
newBuckets =
CompletionBuckets
buckets
{ incomplete :: [Objective]
incomplete = [Objective] -> [Objective]
f forall a b. (a -> b) -> a -> b
$ CompletionBuckets -> [Objective]
incomplete CompletionBuckets
buckets
}
addIncomplete :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addIncomplete :: Objective -> ObjectiveCompletion -> ObjectiveCompletion
addIncomplete Objective
obj = ([Objective] -> [Objective])
-> ObjectiveCompletion -> ObjectiveCompletion
setIncomplete (Objective
obj forall a. a -> [a] -> [a]
:)
extractIncomplete :: ObjectiveCompletion -> (ObjectiveCompletion, [Objective])
ObjectiveCompletion
oc =
(ObjectiveCompletion
withoutIncomplete, [Objective]
incompleteGoals)
where
incompleteGoals :: [Objective]
incompleteGoals = CompletionBuckets -> [Objective]
incomplete forall a b. (a -> b) -> a -> b
$ ObjectiveCompletion -> CompletionBuckets
completionBuckets ObjectiveCompletion
oc
withoutIncomplete :: ObjectiveCompletion
withoutIncomplete = ([Objective] -> [Objective])
-> ObjectiveCompletion -> ObjectiveCompletion
setIncomplete (forall a b. a -> b -> a
const []) ObjectiveCompletion
oc