module Game.LambdaHack.Content.ModeKind
( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN
, ModeKind(..), makeData
, Caves, Roster
, mandatoryGroups
#ifdef EXPOSE_INTERNAL
, validateSingle, validateAll, validateSingleRoster
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Text as T
import Game.LambdaHack.Content.CaveKind (CaveKind)
import Game.LambdaHack.Content.FactionKind
(FactionKind (..), Outcome (..))
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Definition.ContentData
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.DefsInternal
data ModeKind = ModeKind
{ ModeKind -> Text
mname :: Text
, ModeKind -> Freqs ModeKind
mfreq :: Freqs ModeKind
, ModeKind -> Bool
mtutorial :: Bool
, ModeKind -> Bool
mattract :: Bool
, ModeKind -> Roster
mroster :: Roster
, ModeKind -> Caves
mcaves :: Caves
, ModeKind -> [(Outcome, Text)]
mendMsg :: [(Outcome, Text)]
, ModeKind -> Text
mrules :: Text
, ModeKind -> Text
mdesc :: Text
, ModeKind -> Text
mreason :: Text
, ModeKind -> Text
mhint :: Text
}
deriving Int -> ModeKind -> ShowS
[ModeKind] -> ShowS
ModeKind -> String
(Int -> ModeKind -> ShowS)
-> (ModeKind -> String) -> ([ModeKind] -> ShowS) -> Show ModeKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModeKind -> ShowS
showsPrec :: Int -> ModeKind -> ShowS
$cshow :: ModeKind -> String
show :: ModeKind -> String
$cshowList :: [ModeKind] -> ShowS
showList :: [ModeKind] -> ShowS
Show
type Caves = [([Int], [GroupName CaveKind])]
type Roster = [( GroupName FactionKind
, [(Int, Dice.Dice, GroupName ItemKind)] )]
validateSingle :: ContentData FactionKind -> ModeKind -> [Text]
validateSingle :: ContentData FactionKind -> ModeKind -> [Text]
validateSingle ContentData FactionKind
cofact ModeKind{Bool
Caves
Roster
Freqs ModeKind
[(Outcome, Text)]
Text
mname :: ModeKind -> Text
mfreq :: ModeKind -> Freqs ModeKind
mtutorial :: ModeKind -> Bool
mattract :: ModeKind -> Bool
mroster :: ModeKind -> Roster
mcaves :: ModeKind -> Caves
mendMsg :: ModeKind -> [(Outcome, Text)]
mrules :: ModeKind -> Text
mdesc :: ModeKind -> Text
mreason :: ModeKind -> Text
mhint :: ModeKind -> Text
mname :: Text
mfreq :: Freqs ModeKind
mtutorial :: Bool
mattract :: Bool
mroster :: Roster
mcaves :: Caves
mendMsg :: [(Outcome, Text)]
mrules :: Text
mdesc :: Text
mreason :: Text
mhint :: Text
..} =
[ Text
"mname longer than 22" | Text -> Int
T.length Text
mname Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
22 ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let f :: ([a], [a]) -> [Text]
f cave :: ([a], [a])
cave@([a]
ns, [a]
l) =
[ Text
"not enough or too many levels for required cave groups:"
Text -> Text -> Text
<+> ([a], [a]) -> Text
forall a. Show a => a -> Text
tshow ([a], [a])
cave
| [a] -> Int
forall a. [a] -> Int
length [a]
ns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [a] -> Int
forall a. [a] -> Int
length [a]
l ]
in (([Int], [GroupName CaveKind]) -> [Text]) -> Caves -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], [GroupName CaveKind]) -> [Text]
forall {a} {a}. (Show a, Show a) => ([a], [a]) -> [Text]
f Caves
mcaves
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster ContentData FactionKind
cofact Caves
mcaves Roster
mroster
validateSingleRoster :: ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster :: ContentData FactionKind -> Caves -> Roster -> [Text]
validateSingleRoster ContentData FactionKind
cofact Caves
caves Roster
roster =
let emptyGroups :: [GroupName FactionKind]
emptyGroups = (GroupName FactionKind -> Bool)
-> [GroupName FactionKind] -> [GroupName FactionKind]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (GroupName FactionKind -> Bool) -> GroupName FactionKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentData FactionKind -> GroupName FactionKind -> Bool
forall a. ContentData a -> GroupName a -> Bool
oexistsGroup ContentData FactionKind
cofact) ([GroupName FactionKind] -> [GroupName FactionKind])
-> [GroupName FactionKind] -> [GroupName FactionKind]
forall a b. (a -> b) -> a -> b
$ ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> GroupName FactionKind)
-> Roster -> [GroupName FactionKind]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> GroupName FactionKind
forall a b. (a, b) -> a
fst Roster
roster
in [ Text
"the following faction kind groups have no representative with non-zero frequency:"
Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate Text
", " ((GroupName FactionKind -> Text)
-> [GroupName FactionKind] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map GroupName FactionKind -> Text
forall c. GroupName c -> Text
displayGroupName [GroupName FactionKind]
emptyGroups)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [GroupName FactionKind] -> Bool
forall a. [a] -> Bool
null [GroupName FactionKind]
emptyGroups ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkKeepsAlive :: Bool -> p -> p -> FactionKind -> Bool
fkKeepsAlive Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
&& FactionKind -> Bool
fneverEmpty FactionKind
fk
fkGroupKeepsAlive :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupKeepsAlive (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkKeepsAlive Bool
True
in [ Text
"potentially no faction keeps the dungeon alive"
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> Bool)
-> Roster -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupKeepsAlive Roster
roster ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkHasUIor :: Bool -> p -> p -> FactionKind -> Bool
fkHasUIor Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
|| FactionKind -> Bool
fhasUI FactionKind
fk
fkGroupHasUIor :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIor (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkHasUIor Bool
False
in [ Text
"potentially more than one UI client"
| Roster -> Int
forall a. [a] -> Int
length (((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> Bool)
-> Roster -> Roster
forall a. (a -> Bool) -> [a] -> [a]
filter (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIor Roster
roster) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkHasUIand :: Bool -> p -> p -> FactionKind -> Bool
fkHasUIand Bool
acc p
_ p
_ FactionKind
fk = Bool
acc Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasUI FactionKind
fk
fkGroupHasUIand :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIand (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) =
ContentData FactionKind
-> GroupName FactionKind
-> (Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup Bool -> Int -> ContentId FactionKind -> FactionKind -> Bool
forall {p} {p}. Bool -> p -> p -> FactionKind -> Bool
fkHasUIand Bool
True
in [ Text
"potentially less than one UI client"
| Bool -> Bool
not (((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> Bool)
-> Roster -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)]) -> Bool
fkGroupHasUIand Roster
roster) ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let fkTokens :: [TeamContinuity] -> p -> p -> FactionKind -> [TeamContinuity]
fkTokens [TeamContinuity]
acc p
_ p
_ FactionKind
fk = FactionKind -> TeamContinuity
fteam FactionKind
fk TeamContinuity -> [TeamContinuity] -> [TeamContinuity]
forall a. a -> [a] -> [a]
: [TeamContinuity]
acc
fkGroupTokens :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
fkGroupTokens (GroupName FactionKind
fkGroup, [(Int, Dice, GroupName ItemKind)]
_) = ContentData FactionKind
-> GroupName FactionKind
-> ([TeamContinuity]
-> Int -> ContentId FactionKind -> FactionKind -> [TeamContinuity])
-> [TeamContinuity]
-> [TeamContinuity]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData FactionKind
cofact GroupName FactionKind
fkGroup [TeamContinuity]
-> Int -> ContentId FactionKind -> FactionKind -> [TeamContinuity]
forall {p} {p}.
[TeamContinuity] -> p -> p -> FactionKind -> [TeamContinuity]
fkTokens []
tokens :: [TeamContinuity]
tokens = ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity])
-> Roster -> [TeamContinuity]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([TeamContinuity] -> [TeamContinuity]
forall a. Eq a => [a] -> [a]
nub ([TeamContinuity] -> [TeamContinuity])
-> ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity])
-> (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamContinuity] -> [TeamContinuity]
forall a. Ord a => [a] -> [a]
sort ([TeamContinuity] -> [TeamContinuity])
-> ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity])
-> (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [TeamContinuity]
fkGroupTokens) Roster
roster
nubTokens :: [TeamContinuity]
nubTokens = [TeamContinuity] -> [TeamContinuity]
forall a. Eq a => [a] -> [a]
nub ([TeamContinuity] -> [TeamContinuity])
-> ([TeamContinuity] -> [TeamContinuity])
-> [TeamContinuity]
-> [TeamContinuity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TeamContinuity] -> [TeamContinuity]
forall a. Ord a => [a] -> [a]
sort ([TeamContinuity] -> [TeamContinuity])
-> [TeamContinuity] -> [TeamContinuity]
forall a b. (a -> b) -> a -> b
$ [TeamContinuity]
tokens
in [ Text
"potentially duplicate team continuity token"
| [TeamContinuity] -> Int
forall a. [a] -> Int
length [TeamContinuity]
tokens Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [TeamContinuity] -> Int
forall a. [a] -> Int
length [TeamContinuity]
nubTokens ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ let keys :: [Int]
keys = (([Int], [GroupName CaveKind]) -> [Int]) -> Caves -> [Int]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int], [GroupName CaveKind]) -> [Int]
forall a b. (a, b) -> a
fst Caves
caves
minD :: Int
minD = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Int]
keys
maxD :: Int
maxD = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
keys
f :: (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f (GroupName FactionKind
_, [(Int, Dice, GroupName ItemKind)]
l) = ((Int, Dice, GroupName ItemKind) -> [Text])
-> [(Int, Dice, GroupName ItemKind)] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Dice, GroupName ItemKind) -> [Text]
g [(Int, Dice, GroupName ItemKind)]
l
g :: (Int, Dice, GroupName ItemKind) -> [Text]
g i3 :: (Int, Dice, GroupName ItemKind)
i3@(Int
ln, Dice
_, GroupName ItemKind
_) =
[ Text
"initial actor levels not among caves:" Text -> Text -> Text
<+> (Int, Dice, GroupName ItemKind) -> Text
forall a. Show a => a -> Text
tshow (Int, Dice, GroupName ItemKind)
i3
| Int
ln Int -> [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Int]
keys ]
in ((GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [Text])
-> Roster -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupName FactionKind, [(Int, Dice, GroupName ItemKind)])
-> [Text]
f Roster
roster
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"player is confused by both positive and negative level numbers"
| Bool -> Bool
not ([Int] -> Bool
forall a. [a] -> Bool
null [Int]
keys) Bool -> Bool -> Bool
&& Int -> Int
forall a. Num a => a -> a
signum Int
minD Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int -> Int
forall a. Num a => a -> a
signum Int
maxD ]
[Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ Text
"player is confused by level numer zero"
| Int
0 Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
keys ]
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
validateAll [ModeKind]
_ ContentData ModeKind
_ = []
mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups :: [GroupName ModeKind]
mandatoryGroups =
[GroupName ModeKind
CAMPAIGN_SCENARIO, GroupName ModeKind
INSERT_COIN]
pattern CAMPAIGN_SCENARIO, INSERT_COIN :: GroupName ModeKind
pattern $mCAMPAIGN_SCENARIO :: forall {r}. GroupName ModeKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bCAMPAIGN_SCENARIO :: GroupName ModeKind
CAMPAIGN_SCENARIO = GroupName "campaign scenario"
pattern $mINSERT_COIN :: forall {r}. GroupName ModeKind -> ((# #) -> r) -> ((# #) -> r) -> r
$bINSERT_COIN :: GroupName ModeKind
INSERT_COIN = GroupName "insert coin"
makeData :: ContentData FactionKind
-> [ModeKind] -> [GroupName ModeKind] -> [GroupName ModeKind]
-> ContentData ModeKind
makeData :: ContentData FactionKind
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
makeData ContentData FactionKind
cofact [ModeKind]
content [GroupName ModeKind]
groupNamesSingleton [GroupName ModeKind]
groupNames =
String
-> (ModeKind -> Text)
-> (ModeKind -> Freqs ModeKind)
-> (ModeKind -> [Text])
-> ([ModeKind] -> ContentData ModeKind -> [Text])
-> [ModeKind]
-> [GroupName ModeKind]
-> [GroupName ModeKind]
-> ContentData ModeKind
forall c.
Show c =>
String
-> (c -> Text)
-> (c -> Freqs c)
-> (c -> [Text])
-> ([c] -> ContentData c -> [Text])
-> [c]
-> [GroupName c]
-> [GroupName c]
-> ContentData c
makeContentData String
"ModeKind" ModeKind -> Text
mname ModeKind -> Freqs ModeKind
mfreq (ContentData FactionKind -> ModeKind -> [Text]
validateSingle ContentData FactionKind
cofact) [ModeKind] -> ContentData ModeKind -> [Text]
validateAll
[ModeKind]
content
[GroupName ModeKind]
groupNamesSingleton
([GroupName ModeKind]
mandatoryGroups [GroupName ModeKind]
-> [GroupName ModeKind] -> [GroupName ModeKind]
forall a. [a] -> [a] -> [a]
++ [GroupName ModeKind]
groupNames)