    -- | The type of game modes.
    module Game.LambdaHack.Content.ModeKind
      ( pattern CAMPAIGN_SCENARIO, pattern INSERT_COIN
      , ModeKind(..), makeData
      , Caves, Roster
      , mandatoryGroups
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , 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

    -- | Game mode specification.
    data ModeKind = ModeKind
      { ModeKind -> Text
    mname     :: Text            -- ^ short description
      , ModeKind -> Freqs ModeKind
    mfreq     :: Freqs ModeKind  -- ^ frequency within groups
      , ModeKind -> Bool
    mtutorial :: Bool            -- ^ whether to show tutorial messages, etc.
      , ModeKind -> Bool
    mattract  :: Bool            -- ^ whether this is an attract mode
      , ModeKind -> Roster
    mroster   :: Roster          -- ^ factions taking part in the game
      , ModeKind -> Caves
    mcaves    :: Caves           -- ^ arena of the game
      , ModeKind -> [(Outcome, Text)]
    mendMsg   :: [(Outcome, Text)]
          -- ^ messages displayed at each particular game ends; if message empty,
          --   the screen is skipped
      , ModeKind -> Text
    mrules    :: Text            -- ^ rules note
      , ModeKind -> Text
    mdesc     :: Text            -- ^ description
      , ModeKind -> Text
    mreason   :: Text            -- ^ why/when the mode should be played
      , ModeKind -> Text
    mhint     :: Text            -- ^ hints in case player faces difficulties
      }
      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

    -- | Requested cave groups for particular level intervals.
    type Caves = [([Int], [GroupName CaveKind])]

    -- | The specification of factions and of levels, numbers and groups
    -- of their initial members.
    type Roster = [( GroupName FactionKind
                   , [(Int, Dice.Dice, GroupName ItemKind)] )]

    -- | Catch invalid game mode kind definitions.
    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

    -- | Checks, in particular, that there is at least one faction with fneverEmpty
    -- or the game would get stuck as soon as the dungeon is devoid of actors.
    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
               -- all of group elements have to keep level alive, hence conjunction
             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
               -- single group element having UI already incurs the risk
               -- of duplication, hence disjunction
             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
               -- single group element missing UI already incurs the risk
               -- of no UI in the whole game, hence disjunction
             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  -- permitted to be empty, for tests
             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 ]

    -- | Validate game mode kinds together.
    validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
    validateAll :: [ModeKind] -> ContentData ModeKind -> [Text]
    validateAll [ModeKind]
    _ ContentData ModeKind
    _ = []  -- so far, always valid

    -- * Mandatory item groups

    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)