content: -- | A game requires the engine provided by the library, perhaps customized,
  -- and game content, defined completely afresh for the particular game.
  -- The possible kinds of content are fixed in the library and all defined
  -- within the library source code directory. On the other hand, game content,
  -- is defined in the directory hosting the particular game definition.
  --
  -- Content of a given kind is just a list of content items.
  -- After the list is verified and the data preprocessed, it's held
  -- in the @ContentData@ datatype.
  module Game.LambdaHack.Definition.ContentData
    ( ContentData
    , validateRarity, validFreqs
    , emptyContentData, makeContentData
    , okind, omemberGroup, oexistsGroup, oisSingletonGroup, ouniqGroup, opick
    , ofoldlWithKey', ofoldlGroup', omapVector, oimapVector, olength
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Data.Function
  import qualified Data.Map.Strict as M
  import qualified Data.Set as S
  import qualified Data.Text as T
  import qualified Data.Vector as V
  
  import Game.LambdaHack.Core.Frequency
  import Game.LambdaHack.Core.Random
  import Game.LambdaHack.Definition.Defs
  import Game.LambdaHack.Definition.DefsInternal
  
  -- | Verified and preprocessed content data of a particular kind.
  data ContentData c = ContentData
    { contentVector :: V.Vector c
    , groupFreq     :: M.Map (GroupName c) [(Int, (ContentId c, c))]
    }
  
  maxContentId :: ContentId k
  maxContentId = toContentId maxBound
  
  validateRarity :: Rarity -> [Text]
  validateRarity rarity =
    -- @SortOn@ less efficient here, because function cheap.
    let sortedRarity = sortBy (comparing fst) rarity
    in [ "rarity not sorted" | sortedRarity /= rarity ]
       ++ [ "rarity depth thresholds not unique"
          | map head (groupBy ((==) `on` fst) sortedRarity) /= sortedRarity ]
       ++ [ "rarity depth not positive"
          | case sortedRarity of
              ((lowest, _) : _) -> lowest <= 0
              _ -> False ]
  
  validFreqs :: Freqs a -> Bool
  validFreqs freqs =
    -- Greater or equal to 0 permitted, e.g., to cover embedded template UNKNOWN
    -- items not yet identified by the client, but triggerable nevertheless.
    all ((>= 0) . snd) freqs
    && let groups = sort $ map fst freqs
           tailOfGroups = if null groups then groups else tail groups
       in all (uncurry (/=)) $ zip groups tailOfGroups
  
  emptyContentData :: ContentData a
  emptyContentData = ContentData V.empty M.empty
  
  makeContentData :: Show c
                  => String
                  -> (c -> Text)
                       -- ^ name of the content itme, used for validation
                  -> (c -> Freqs c)
                       -- ^ frequency in groups, for validation and preprocessing
                  -> (c -> [Text])
                       -- ^ validate a content item and list all offences
                  -> ([c] -> ContentData c -> [Text])
                       -- ^ validate the whole defined content of this type
                       -- and list all offence
                  -> [c]  -- ^ all content of this type
                  -> [GroupName c]  -- ^ singleton group names for this content
                  -> [GroupName c]  -- ^ remaining group names for this content
                  -> ContentData c
  {-# INLINE makeContentData #-}
  makeContentData contentName getName getFreq validateSingle validateAll
                  content groupNamesSingleton groupNames =
    -- The @force@ is needed for @GHC.Compact@.
    let contentVector = V.force $ V.fromList content
        groupFreq =
          let tuples = [ (cgroup, (n, (i, k)))
                       | (i, k) <- zip (map toContentId [0..]) content
                       , (cgroup, n) <- getFreq k
                       , n > 0 ]
              f !m (!cgroup, !nik) = M.insertWith (++) cgroup [nik] m
          in foldl' f M.empty tuples
        contentData = ContentData {..}
        singleOffenders = [ (offences, a)
                          | a <- content
                          , let offences = validateSingle a
                                           ++ ["empty name" | T.null (getName a)]
                          , not (null offences) ]
        allOffences = validateAll content contentData
        freqsOffenders = filter (not . validFreqs . getFreq) content
        allGroupNamesEmpty = filter (T.null . fromGroupName)
                             $ groupNamesSingleton ++ groupNames
        allGroupNamesTooLong = filter ((> 30) . T.length . fromGroupName)
                               $ groupNamesSingleton ++ groupNames
        allGroupNamesSorted = sort $ groupNamesSingleton ++ groupNames
        allGroupNamesUnique = nub allGroupNamesSorted
        allGroupNamesNonUnique = allGroupNamesSorted \\ allGroupNamesUnique
        missingGroups = filter (not . omemberGroup contentData)
                               (groupNamesSingleton ++ groupNames)
        groupsMoreThanOne = filter (not . oisSingletonGroup contentData)
                                   groupNamesSingleton
        groupsDeclaredSet = S.fromAscList allGroupNamesUnique
        groupsNotDeclared = filter (`S.notMember` groupsDeclaredSet)
                            $ M.keys groupFreq
    in assert (null allGroupNamesEmpty
               `blame` contentName ++ ": some group names empty"
               `swith` allGroupNamesEmpty) $
       assert (null allGroupNamesTooLong
               `blame` contentName ++ ": some group names too long"
               `swith` allGroupNamesTooLong) $
       assert (null allGroupNamesNonUnique
               `blame` contentName ++ ": some group names duplicated"
               `swith` allGroupNamesNonUnique) $
       assert (null missingGroups
               `blame` contentName ++ ": some group names pertain to no content"
               `swith` missingGroups) $
       assert (null groupsMoreThanOne
               `blame` contentName ++ ": some group names refer to more than one content, while they shouldn't"
               `swith` groupsMoreThanOne) $
       assert (null groupsNotDeclared
               `blame` contentName ++ ": some group names are not included in group name lists, neither singleton nor duplicable"
               `swith` groupsNotDeclared) $
       assert (null freqsOffenders
               `blame` contentName ++ ": some Freqs values not valid"
               `swith` freqsOffenders) $
       assert (null singleOffenders
               `blame` contentName ++ ": some content items not valid"
               `swith` singleOffenders) $
       assert (null allOffences
               `blame` contentName ++ ": the content set is not valid"
               `swith` allOffences) $
       assert (V.length contentVector <= contentIdIndex maxContentId
               `blame` contentName ++ ": the content has too many elements")
       contentData
  
  -- | Content element at given id.
  okind :: ContentData a -> ContentId a -> a
  {-# INLINE okind #-}
  okind ContentData{contentVector} !i = contentVector V.! contentIdIndex i
  
  omemberGroup :: ContentData a -> GroupName a -> Bool
  omemberGroup ContentData{groupFreq} cgroup = cgroup `M.member` groupFreq
  
  oexistsGroup :: ContentData a -> GroupName a -> Bool
  oexistsGroup ContentData{groupFreq} cgroup = case M.lookup cgroup groupFreq of
    Nothing -> False
    Just l -> all ((> 0) . fst) l
  
  oisSingletonGroup :: ContentData a -> GroupName a -> Bool
  oisSingletonGroup ContentData{groupFreq} cgroup =
    case M.lookup cgroup groupFreq of
      Just [_] -> True
      _ -> False
  
  -- | The id of the unique member of a singleton content group.
  ouniqGroup :: Show a => ContentData a -> GroupName a -> ContentId a
  ouniqGroup ContentData{groupFreq} !cgroup =
    let freq = let assFail = error $ "no unique group"
                                     `showFailure` (cgroup, groupFreq)
               in M.findWithDefault assFail cgroup groupFreq
    in case freq of
      [(n, (i, _))] | n > 0 -> i
      l -> error $ "not unique" `showFailure` (cgroup, l)
  
  -- | Pick a random id belonging to a group and satisfying a predicate.
  opick :: Show a
        => ContentData a
        -> GroupName a -> (a -> Bool) -> Rnd (Maybe (ContentId a))
  opick ContentData{groupFreq} !cgroup !p =
    case M.lookup cgroup groupFreq of
      Just freqRaw ->
        let freq = toFreq "opick" $ filter (p . snd . snd) freqRaw
        in if nullFreq freq
           then return Nothing
           else Just . fst <$> frequency freq
      _ -> return Nothing
  
  -- | Fold strictly over all content @a@.
  ofoldlWithKey' :: ContentData a -> (b -> ContentId a -> a -> b) -> b -> b
  ofoldlWithKey' ContentData{contentVector} f z =
    V.ifoldl' (\ !a !i !c -> f a (toContentId $ toEnum i) c) z contentVector
  
  -- | Fold over the given group only.
  ofoldlGroup' :: ContentData a
               -> GroupName a
               -> (b -> Int -> ContentId a -> a -> b) -> b -> b
  ofoldlGroup' ContentData{groupFreq} cgroup f z =
    case M.lookup cgroup groupFreq of
      Just freq -> foldl' (\ !acc (!p, (!i, !a)) -> f acc p i a) z freq
      _ -> error $ "no group '" ++ show cgroup
                                ++ "' among content that has groups "
                                ++ show (M.keys groupFreq)
                   `showFailure` ()
  
  omapVector :: ContentData a -> (a -> b) -> V.Vector b
  omapVector d f = V.map f $ contentVector d
  
  oimapVector :: ContentData a -> (ContentId a -> a -> b) -> V.Vector b
  oimapVector d f = V.imap (\i a -> f (toContentId $ toEnum i) a)
                           (contentVector d)
  
  -- | Size of content @a@.
  olength :: ContentData a -> Int
  olength ContentData{contentVector} = V.length contentVector
  