<h2 id="intro">Intro</h2>
<p>In episode hpr2748 Writing Web Game in Haskell - Special events, I talked about how to add special events in the game. One drawback with the system presented there was that the kragii worms might attack planet that already had kragii worms present. This time we’ll look into how to prevent this. As a nice bonus, we also come up with system that can be used to record when a planet has particularly good harvest season.</p>
<h2 id="data-types-and-database">Data types and Database</h2>
<p>We need a way to represent different kinds of statuses that a planet might have. These will include things like on going kragii attack or a particularly good harvest season. And since these are will be stored in database, we are also going to use derivePersistField to generate code needed for that.</p>
<pre><code>data PlanetaryStatus =
    GoodHarvest
    | PoorHarvest
    | GoodMechanicals
    | PoorMechanicals
    | GoodChemicals
    | PoorChemicals
    | KragiiAttack

derivePersistField &quot;PlanetaryStatus&quot;</code></pre>
<p>We could have recorded statuses as strings, but declaring a separate data type means that compiler can catch typos for us. It also makes code easier to read as <code>PlanetaryStatus</code> is much more informative than <code>String</code> or <code>Text</code>.</p>
<p>For database, we use following definition shown below in models file. It creates database table <code>planet_status</code> and respective Haskell data type <code>PlanetStatus</code>. There will be one row in database for each status that a planet has. I could have stored all statuses in a list and store that in database, effectively having one row for any planet. Now there’s one row for any planet + status combination. Choice wasn’t really based on any deep analysis, but merely a gut feeling that this feels like a good idea.</p>
<pre><code>PlanetStatus json
    planetId PlanetId
    status PlanetaryStatus
    expiration Int Maybe
    deriving Show Read Eq</code></pre>
<p><code>expiration</code> column doesn’t have <code>NOT NULL</code> constraint like all other columns in the table. This is reflected in <code>PlanetStatus</code> record where data type of <code>planetStatusExpiration</code> is <code>Maybe Int</code> instead of <code>Int</code>. So some statuses will have expiration time, while others might not. I originally chose to represent time as <code>Int</code> instead of own data type, but I have been recently wondering if that was really a good decision.</p>
<h2 id="kragii-attack-redux">Kragii attack, redux</h2>
<p>Code that does actual database query looks pretty scary on a first glance and it’s rather long. First part of the code is there to query database and join several tables into the query. Second part of the code deals with counting and grouping data and eventually returning <code>[Entity Planet]</code> data that contains all planets that match the criteria.</p>
<pre><code>-- | Load planets that are kragii attack candidates
kragiiTargetPlanets :: (MonadIO m, BackendCompatible SqlBackend backend
                           , PersistQueryRead backend, PersistUniqueRead backend) =&gt;
                           Int -&gt; Int -&gt; Key Faction -&gt; ReaderT backend m [Entity Planet]
kragiiTargetPlanets pop farms fId = do
    planets &lt;- E.select $
        E.from $ (planet `E.LeftOuterJoin` population `E.LeftOuterJoin` building `E.LeftOuterJoin` status) -&gt; do
            E.on (status E.?. PlanetStatusPlanetId E.==. E.just (planet E.^. PlanetId)
                  E.&amp;&amp;. status E.?. PlanetStatusStatus E.==. E.val (Just KragiiAttack))
            E.on (building E.?. BuildingPlanetId E.==. E.just (planet E.^. PlanetId))
            E.on (population E.?. PlanetPopulationPlanetId E.==. E.just (planet E.^. PlanetId))
            E.where_ (planet E.^. PlanetOwnerId E.==. E.val (Just fId)
                      E.&amp;&amp;. building E.?. BuildingType E.==. E.val (Just Farm)
                      E.&amp;&amp;. E.isNothing (status E.?. PlanetStatusStatus))
            E.orderBy [ E.asc (planet E.^. PlanetId) ]
            return (planet, population, building)
    let grouped = groupBy ((a, _, _) (b, _, _) -&gt; entityKey a == entityKey b) planets
    let counted = catMaybes $ fmap farmAndPopCount grouped
    let filtered = filter ((_, p, f) -&gt;
                                p &gt;= pop
                                || f &gt;= farms) counted
    let mapped = fmap ((ent, _, _) -&gt; ent) filtered
    return mapped</code></pre>
<p>In any case, when we’re querying for possible kragii attack candidates, the query selects all planets that are owned by a given faction and have population of at least 10 (left outer join to <code>planet_population</code> table), have at least 5 farming complex (left outer join to <code>building</code> table) and don’t have on going kragii attack (left outer join to <code>planet_status</code> table). This is encapsulated in <code>kragiiTargetPlanets 10 5</code> function in the <code>kragiiAttack</code> function shown below.</p>
<p>Rest of the code deals with selecting a random planet from candidates, inserting a new <code>planet_status</code> row to record that kragii are attacking the planet and creating special event so player is informed about the situation and can react accordingly.</p>
<pre><code>kragiiAttack date faction = do
    planets &lt;- kragiiTargetPlanets 10 5 $ entityKey faction
    if length planets == 0
        then return Nothing
        else do
            n &lt;- liftIO $ randomRIO (0, length planets - 1)
            let planet = maybeGet n planets
            let statusRec = PlanetStatus &lt;$&gt; fmap entityKey planet
                                         &lt;*&gt; Just KragiiAttack
                                         &lt;*&gt; Just Nothing
            _ &lt;- mapM insert statusRec
            starSystem &lt;- mapM (getEntity . planetStarSystemId . entityVal) planet
            let event = join $ kragiiWormsEvent &lt;$&gt; planet &lt;*&gt; join starSystem &lt;*&gt; Just date
            mapM insert event</code></pre>
<p>Second piece to the puzzle is status removal. In can happen manually or automatically when the prerecorded date has passed. Former method is useful for special events and latter for kind of seasonal things (good harvest for example).</p>
<p>For example, in case of removing kragii attack status, code below serves as an example. The interesting part is <code>deleteWhere</code> that does actual database activity and removes all <code>KragiiAttack</code> statuses from given planet.</p>
<pre><code>removeNews event odds = MaybeT $ do
    res &lt;- liftIO $ roll odds
    case res of
        Success -&gt; do
            _ &lt;- lift $ deleteWhere [ PlanetStatusPlanetId ==. kragiiWormsPlanetId event
                                    , PlanetStatusStatus ==. KragiiAttack
                                    ]
            _ &lt;- tell [ WormsRemoved ]
            return $ Just RemoveOriginalEvent
        Failure -&gt; do
            _ &lt;- tell [ WormsStillPresent ]
    return $ Just KeepOriginalEvent</code></pre>
<p>Removal of expired statuses is done based on the date, by using <code>&lt;=.</code> operator to compare <code>expiration</code> column to given date.</p>
<pre><code>_ &lt;- deleteWhere [ PlanetStatusExpiration &lt;=. Just date]</code></pre>
<h2 id="other-uses-and-further-plans">Other uses and further plans</h2>
<p>Like mentioned before, planet statuses can be used for variety of things. One such application is recording particularly good (or poor) harvest season. When such thing occurs, new <code>planet_status</code> record is inserted into database with <code>expiration</code> to set some suitable point in future. System will then automatically remove the status after that date is reached.</p>
<p>In the meantime, every time food production is calculated, we have to check for possible statuses that might affect it and take them into account (as form of small bonus or malus).</p>
<p>While this system is for planet statuses only, similar systems can be build for other uses (like statuses that affect a single ship or whole star system).</p>
<p>Easiest way to catch me nowadays is either via email or on fediverse where I’m Tuula@mastodon.social</p>
