Site Map - skip to main content - dyslexic font - mobile - text - print

Hobby Public Radio

Your ideas, projects, opinions - podcasted.

New episodes Monday through Friday.


Correspondent

tuturto

Host Image
Host ID: 364

Eternal tinkerer of code, who occasionally writes things down at https://engineersjourney.wordpress.com/ or contributes to hylang project at https://github.com/hylang/hy


email: tuukka.turto.nospam@nospam.oktaeder.net
episodes: 15

hpr2768 :: Writing Web Game in Haskell - Planetary statuses

Released on 2019-03-13 under a CC-BY-SA license.

Intro

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.

Data types and Database

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.

data PlanetaryStatus =
    GoodHarvest
    | PoorHarvest
    | GoodMechanicals
    | PoorMechanicals
    | GoodChemicals
    | PoorChemicals
    | KragiiAttack

derivePersistField "PlanetaryStatus"

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 PlanetaryStatus is much more informative than String or Text.

For database, we use following definition shown below in models file. It creates database table planet_status and respective Haskell data type PlanetStatus. 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.

PlanetStatus json
    planetId PlanetId
    status PlanetaryStatus
    expiration Int Maybe
    deriving Show Read Eq

expiration column doesn’t have NOT NULL constraint like all other columns in the table. This is reflected in PlanetStatus record where data type of planetStatusExpiration is Maybe Int instead of Int. So some statuses will have expiration time, while others might not. I originally chose to represent time as Int instead of own data type, but I have been recently wondering if that was really a good decision.

Kragii attack, redux

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 [Entity Planet] data that contains all planets that match the criteria.

-- | Load planets that are kragii attack candidates
kragiiTargetPlanets :: (MonadIO m, BackendCompatible SqlBackend backend
                           , PersistQueryRead backend, PersistUniqueRead backend) =>
                           Int -> Int -> Key Faction -> ReaderT backend m [Entity Planet]
kragiiTargetPlanets pop farms fId = do
    planets <- E.select $
        E.from $ (planet `E.LeftOuterJoin` population `E.LeftOuterJoin` building `E.LeftOuterJoin` status) -> do
            E.on (status E.?. PlanetStatusPlanetId E.==. E.just (planet E.^. PlanetId)
                  E.&&. 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.&&. building E.?. BuildingType E.==. E.val (Just Farm)
                      E.&&. E.isNothing (status E.?. PlanetStatusStatus))
            E.orderBy [ E.asc (planet E.^. PlanetId) ]
            return (planet, population, building)
    let grouped = groupBy ((a, _, _) (b, _, _) -> entityKey a == entityKey b) planets
    let counted = catMaybes $ fmap farmAndPopCount grouped
    let filtered = filter ((_, p, f) ->
                                p >= pop
                                || f >= farms) counted
    let mapped = fmap ((ent, _, _) -> ent) filtered
    return mapped

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 planet_population table), have at least 5 farming complex (left outer join to building table) and don’t have on going kragii attack (left outer join to planet_status table). This is encapsulated in kragiiTargetPlanets 10 5 function in the kragiiAttack function shown below.

Rest of the code deals with selecting a random planet from candidates, inserting a new planet_status row to record that kragii are attacking the planet and creating special event so player is informed about the situation and can react accordingly.

kragiiAttack date faction = do
    planets <- kragiiTargetPlanets 10 5 $ entityKey faction
    if length planets == 0
        then return Nothing
        else do
            n <- liftIO $ randomRIO (0, length planets - 1)
            let planet = maybeGet n planets
            let statusRec = PlanetStatus <$> fmap entityKey planet
                                         <*> Just KragiiAttack
                                         <*> Just Nothing
            _ <- mapM insert statusRec
            starSystem <- mapM (getEntity . planetStarSystemId . entityVal) planet
            let event = join $ kragiiWormsEvent <$> planet <*> join starSystem <*> Just date
            mapM insert event

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).

For example, in case of removing kragii attack status, code below serves as an example. The interesting part is deleteWhere that does actual database activity and removes all KragiiAttack statuses from given planet.

removeNews event odds = MaybeT $ do
    res <- liftIO $ roll odds
    case res of
        Success -> do
            _ <- lift $ deleteWhere [ PlanetStatusPlanetId ==. kragiiWormsPlanetId event
                                    , PlanetStatusStatus ==. KragiiAttack
                                    ]
            _ <- tell [ WormsRemoved ]
            return $ Just RemoveOriginalEvent
        Failure -> do
            _ <- tell [ WormsStillPresent ]
    return $ Just KeepOriginalEvent

Removal of expired statuses is done based on the date, by using <=. operator to compare expiration column to given date.

_ <- deleteWhere [ PlanetStatusExpiration <=. Just date]

Other uses and further plans

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 planet_status record is inserted into database with expiration to set some suitable point in future. System will then automatically remove the status after that date is reached.

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).

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).

Easiest way to catch me nowadays is either via email or on fediverse where I’m tuturto@mastodon.social


hpr2758 :: Haskell - Data types and database actions

Released on 2019-02-27 under a CC-BY-SA license.

Intro

I have been doing series about web programming in Haskell and realized that I might have skipped over some very basic details. Better later than never, I’ll go over some of them briefly (data types and database actions). Hopefully things will make more sense after this (like with my friend, whose last programming course was programming 101 and they said afterwards that now all that 3d and game programming is suddenly making sense).

Data types

Data here has nothing to do with databases (yet). This is how you can declare your own data types in Haskell. They’re declared with keyword data followed with type name, equals sign and one or more value constructors. Type name and value constructors have to start with uppercase letter.

Simplest type is following:

data Simple = One

This declares a type called Simple that has single possible value: One.

More interesting type is shown below. Colour has three possible values: Red, Green and Blue.

data Colour =
    Red
    | Green
    | Blue

It’s possible to have parameters in value constructor. Following is Payment type that could be used to indicate how payment was done. In case of Cash amount is stored. In case of IOU free text is recorded.

data Payment =
    Cash Double
    | IOU Text

Fictional usage of the Payment is shown below. Function paymentExplanation takes a Payment as parameter and returns Text describing the payment. In case of cash payment, brief explanation of how much was paid is returned. In case of IOU slip the function returns explanation stored in IOU value.

paymentExplanation :: Payment -> Text part is type declaration. It states that paymentExplanation takes argument of type Payment and returns result as Text.

paymentExplanation :: Payment -> Text
paymentExplanation payment =
    case payment of
        Cash amount ->
            "Cash payment of " <> (show amount) <> " euros"
        IOU explanation ->
            explanation

Parameters don’t have to be hard coded in the type definition. Parametrized types allows creating more general code. Maybe is very useful data type that is often used for data that might or might not be present. It can have two values: Nothing indicating that there isn’t value and Just a indicating that value is present.

data Maybe a =
    Nothing
    | Just a

a is type parameter that is filled in when declaring type. Below is a function that takes Maybe Payment as a parameter and if value of payment parameter is Just returns explanation of it (reusing the function we declared earlier). In case of Nothing "No payment to handle" is returned.

invoice :: Maybe Payment -> Text
invoice payment =
    case payment of
        Just x ->
            paymentExplanation x
        Nothing ->
            "No payment to handle"

Alternatively one can omit case expression as shown below and write different value constructors directly as parameters. In both cases, compiler will check that programmer has covered all cases and emit a warning if that’s not the case.

invoice :: Maybe Payment -> Text
invoice (Just payment) =
    paymentExplanation payment

invoice Nothing =
    "No payment to handle"

Having several parameters gets soon unwieldy, so lets introduce records. With them, fields have names that can be used when referring to them (either when creating or when accessing the data). Below is Person record with two fields. personName is of type Text and personAge of type Age (that we’ll define in the next step).

data Person = Person
    { personName :: Text
    , personAge :: Age
    }

To access data in a record, just use field as a function (there’s a bug, I’m turning 40, this month (today even, to be specific, didn’t realize this until I was about to upload the episode), but forgot such a minor detail when recording the episode):

me = Person { personName = "Tuukka", personAge = 37 }
myAge = personAge me
myName = personName me

New type is special type of record that can has only one field. It is often used to make sure one doesn’t mix similar data types (shoe size and age can both be Ints and thus mixed if programmer isn’t being careful). Compiler will optimize new types away during compilation, after checking that they’re being used correctly. This offers a tiny performance boost and makes sure one doesn’t accidentally mix different things that happen to look similar.

newtype Age = { getAge :: Int }

One can instruct compiler to derive some common functions for the data types. There are quite many of these, but the most common ones I’m using are Show (for turning data into text), Read (turning text into data) and Eq (comparing equality).

data Payment =
    Cash Double
    | IOU Text
    deriving (Show, Read, Eq)

Database

In case of Yesod and Persistent, database structure is defined in models file that usually located in config directory. It is read during compile time and used to generate data types that match the database. When the program starts up, it can check structure of the database and update it to match the models file, if migrations are turned on. While this is handy for development, I wouldn’t dare to use it for production data.

Following definitions are lifted from the models file of the game I’m working.

StarSystem
    name Text
    coordX Int
    coordY Int
    deriving Show Read Eq

This defines a table star_system with columns id, name, coord_x, coord_y. All columns have NOT NULL constraint on them. It also defines record StarSystem with fields starSystemName, starSystemCoordX and starSystemCoordY.

Star
    name Text
    starSystemId StarSystemId
    spectralType SpectralType
    luminosityClass LuminosityClass
    deriving Show Read Eq

This works in the same way and defines table star and record Star. New here is column star_system_id that has foreign key constraint linking it to star_system table. Star record has field starStarSystemId (silly name, I know, but that’s how the generated names go), which has type Key StarSystem.

spectral_type and luminosity_class columns in the database are textual (I think VARCHAR), but in the code they’re represented with SpectralType and LuminosityClass data types. In order this to work, we have to define them as normal data types and use derivePersistField that generates extra code needed to store them as text in database:

data SpectralType = O | B | A | F | G | K | M | L | T
    deriving (Show, Read, Eq)
derivePersistField "SpectralType"

data LuminosityClass = Iap | Ia | Iab | Ib | II | III | IV | V | VI | VII
    deriving (Show, Read, Eq)
derivePersistField "LuminosityClass"

Final piece in the example is Planet:

Planet
    name Text
    position Int
    starSystemId StarSystemId
    ownerId FactionId Maybe
    gravity Double
    SystemPosition starSystemId position
    deriving Show Read Eq

This introduces two new things: ownerId FactionId Maybe removes NOT NULL constraint for this column in the database, allowing us to omit storing a value there. It also changes type of planetOwnerId into Maybe (Key Faction). Thus, planet might or might not have an owner, but if it has, database ensures that the link between planet and faction (not shown here) is always valid.

Second new thing is SystemPosition starSystemId position that creates unique index on columns star_system_id and position. Now only one planet can exists on any given position in a star system.

Database isn’t any good, if we can’t insert any data into it. We can do that with a function shown below, that create a solar system with a single planet:

createSolarSystem = do
    systemId <- insert $ StarSystem "Solar system" 0 0
    starId <- insert $ Star "Sol" systemId G V
    planetId <- insert $ Planet "Terra" 3 systemId Nothing 1.0
    return (systemId, starId, planetId)

To use the function, we have to use runDB function that handles the database transaction:

res <- runDB createSolarSystem

There are various ways of loading data from database. For loading a list of them, selectList is used. Here we’re loading all planets that have gravity exactly 1.0 and ordering results by the primary key in ascending order:

planets <- runDB $ selectList [ PlanetGravity ==. 1.0 ] [ Asc PlanetId ]

Loading by primary key is done with get. It returns Maybe, because data might or might be present that match the primary key. Programmer then has to account both cases when handling the result:

planet <- runDB $ get planetId

Updating a specific row is done with update function (updateWhere is for multiple rows):

_ <- runDB $ update planetId [ PlanetName =. "Earth" ]

Finally, sometimes it’s nice to be able to delete the data:

_ <- runDB $ delete planetId
_ <- runDB $ deleteWhere [ PlanetGravity >. 2 ]

While persistent is relatively easy to use after you get used to it, it lacks ability to do joins. In such cases one can use library called Esqueleto, that is more powerful and has somewhat more complex API.

Extra

Because functions are values in Haskell, nothing prevents storing them in data types:

data Handler =
    Simple (Int -> Boolean)
    | Complex (Int -> Int -> Int)

Handler type has two possible values: Simple has a function that turns Int into Boolean (for example odd used to check if given number is odd) and Complex that takes two values of type Int and returns Int (basic arithmetic for example, adding and subtracting).

Hopefully this helps you to follow along as I work on the game.

Easiest way to catch me nowadays is either via email or on fediverse where I’m tuturto@mastodon.social


hpr2748 :: Writing Web Game in Haskell - Special events

Released on 2019-02-13 under a CC-BY-SA license.

Intro

I was tasked to write kragii worms in the game and informed that they’re small (10cm / 4 inches) long worms that burrow in ground and are drawn to farming fields and people. They’re dangerous and might eat harvest or people.

Special events build on top of the new system I explained in episode 2733. They are read from same API as regular news and need same ToJSON, FromJSON, ToDto and FromDto instances as regular news (for translating them data transfer objects and then into JSON for sending to client).

Loading

Starting from the API interface, the first real difference is when JSON stored into database is turned into NewsArticle. Two cases, where special news have available options added to them and regular news are left unchanged. These options tell player what choices they have when dealing with the situation and evaluated every time special event is loaded, because situation might have changed since special event got stored into database and available options might have changed.

addOptions (key, article) = case article of
                                Special news ->
                                    (key, Special $ availableOptions news)
                                _ ->
                                    (key, article)

availableOptions :: SpecialNews -> SpecialNews
availableOptions x =
    case x of
        KragiiWorms event _ choice ->
            KragiiWorms event (eventOptions event) choice

eventOptions is one of the events defined in SpecialEvent type class that specifies two functions every special event has to have. eventOptions lists what options the event has currently available and resolveEvent resolves the event according to choice user might have made (hence Maybe in it).

Type class is parametrized with three types (imaginatively named to a, b and c). First is data type that holds information about special event (where it’s happening and to who for example), second one is one that tells all possible choices player has and third one lists various results that might occur when resolving the event. In this example they’re KragiiWormsEvent, KragiiWormsChoice and KragiiResults.

data KragiiWormsEvent = KragiiWormsEvent
    { kragiiWormsPlanetId   :: Key Planet
    , kragiiWormsPlanetName :: Text
    , kragiiWormsSystemId   :: Key StarSystem
    , kragiiWormsSystemName :: Text
    , kragiiWormsDate       :: Int
    }

data KragiiWormsChoice =
    EvadeWorms
    | AttackWorms
    | TameWorms

data KragiiResults =
    WormsStillPresent
    | WormsRemoved
    | WormsTamed
    | CropsDestroyed (RawResource Biological)
    | FarmersInjured

Definition of the SpecialEvent type class is shown below. Type signature of resolveEvent is gnarly because it’s reading and writing database.

class SpecialEvent a b c | a -> b, a -> c where
    eventOptions :: a -> [UserOption b]
    resolveEvent :: ( PersistQueryRead backend, PersistQueryWrite backend
                    , MonadIO m, BaseBackend backend ~ SqlBackend ) =>
                    (Key News, a) -> Maybe b -> ReaderT backend m (Maybe EventRemoval, [c])

One more piece we need is UserOption. This records options in a format that is useful in the client side. Each option player has are given title and explanation that are shown on UI.

data UserOption a =
    UserOption { userOptionTitle :: Text
               , userOptionExplanation :: [Text]
               , userOptionChoice :: a
               }

Current implementation of eventOptions doesn’t allow database access, but I’m planning on adding that at the point where I need it. Example doesn’t show all different options, as they all have same structure. Only first option in the list is shown:

eventOptions _ = [ UserOption { userOptionTitle = "Avoid the worms"
                              , userOptionExplanation = [ "Keep using fields, while avoiding the worms and hope they'll eventually leave."
                                                        , "50 units of biologicals lost"
                                                        , "25% chance of worms leaving"
                                                        ]
                              , userOptionChoice = EvadeWorms
                            }
                   , ...
                   ]

Making choice

putApiMessageIdR handles updating news with HTTP PUT messages. First steps is to check that caller has autenticated and retrieve id of their faction. News article that is transferred in body as JSON is parsed and checked for type. Updating regular news articles isn’t supported and is signaled with HTTP 403 status code. One more check to perform is to check that news article being edited actually belong to the faction player is member of. If that’s not the case HTTP 404 message is returned.

If we got this far, news article is updated with the content sent by client (that also contains possible choice made by user). There’s no check that type of news article doesn’t change or that the option selected doesn’t change (I need to add these at later point). In the end, list of all messages is returned back to the client.

putApiMessageIdR :: Key News -> Handler Value
putApiMessageIdR mId = do
    (_, _, fId) <- apiRequireFaction
    msg <- requireJsonBody
    let article = fromDto msg
    _ <- if isSpecialEvent article
            then do
                loadedMessages <- runDB $ selectList [ NewsId ==. mId
                                                     , NewsFactionId ==. fId ] [ Asc NewsDate ]
                if length loadedMessages == 0
                    then apiNotFound
                    else runDB $ update mId [ NewsContent =. (toStrict $ encodeToLazyText article) ]
            else apiForbidden "unsupported article type"
    loadAllMessages fId

Resolving event

Special event occured, user made (or did not) a choice. Now it’s time to simulate what happens. Below is resolveEvent for kragii attack.

resolveEvent keyEventPair (Just choice) =
    runWriterT . runMaybeT $
        case choice of
                EvadeWorms ->
                    chooseToAvoid keyEventPair

                AttackWorms ->
                    chooseToAttack keyEventPair

                TameWorms ->
                    chooseToTame keyEventPair

resolveEvent keyEventPair Nothing =
    runWriterT . runMaybeT $ noChoice keyEventPair

runWriterT and runMaybeT are used as code being called uses monad transformers to add some extra handling. WriterT adds ability to record data (KragiiResult in this case) and MaybeT adds ability to stop computation early if one of the steps return Nothing value.

Let’s walk through what happens when user has chosen to avoid kragii worms and keep working only part of the fields. First step is to load faction information. If faction couldn’t be found, we abort. Next amount of biological matter consumed and how much is left is calculated. Again, if calculation isn’t possible, we’ll abort. This step reaches into database and updates amount of biological matter stored by the faction (again, possibility to stop early). Final step is to check if kragii leave or not (again, chance of abort).

chooseToAvoid :: ( MonadIO m, PersistQueryWrite backend
                 , BaseBackend backend ~ SqlBackend ) =>
                 (Key News, KragiiWormsEvent)
                 -> MaybeT (WriterT [KragiiResults] (ReaderT backend m)) EventRemoval
chooseToAvoid (_, event) = do
    faction <- getFaction event
    (cost, bioLeft) <- calculateNewBio (RawResource 50) (entityVal faction)
    _ <- destroyCrops faction cost bioLeft
    removeNews $ PercentileChance 25

Loading faction has several step. Id is stored in the event is used to load planet. Planet might or might have an owner faction, depending on if it has been settled. This faction id is used to load faction data. Loading might fail if corresponding record has been removed from database and planet might not be settled at the given time. Any of these cases will result Nothing be returned and whole event resolution being aborted. I’m starting to really like that I don’t have to write separate if statements to take care of these special cases.

getFaction :: ( MonadIO m, PersistStoreRead backend
              , BaseBackend backend ~ SqlBackend ) =>
              KragiiWormsEvent
              -> MaybeT (WriterT [KragiiResults] (ReaderT backend m)) (Entity Faction)
getFaction event = MaybeT $ do
    planet <- lift $ get $ kragiiWormsPlanetId event
    let owner = join $ fmap planetOwnerId planet
    res <- lift $ mapM getEntity owner
    return $ join res

Amount of biological matter in store is stored in faction information. If it’s zero or less, Nothing is returned as there’s nothing to do really. In other cases, amount of biological matter left is calculated and result returned in form of ( cost, biological matter left ). I’m carrying around the cost, as it’s later needed for reporting how much matter was removed.

calculateNewBio :: Monad m =>
                RawResource Biological -> Faction
                -> MaybeT (WriterT [KragiiResults] m) ((RawResource Biological), (RawResource Biological))
calculateNewBio cost faction = MaybeT $ do
    let currentBio = factionBiologicals faction
    return $ if currentBio > 0
                then Just $ ( cost
                            , RawResource $ max 0 (currentBio - unRawResource cost))
                else Nothing

destroyCrops updates database with new amount of biological matter in store for the faction and records amount of destruction in CropsDestroyed. tell requires that we have Writer at our disposal and makes recording information nice and easy.

destroyCrops :: ( MonadIO m, PersistQueryWrite backend, BaseBackend backend ~ SqlBackend ) =>
                Entity Faction -> RawResource Biological
                -> RawResource Biological -> MaybeT (WriterT [KragiiResults] (ReaderT backend m)) ()
destroyCrops faction cost bioLeft = MaybeT $ do
    _ <- lift $ updateWhere [ FactionId ==. entityKey faction ]
                            [ FactionBiologicals =. unRawResource bioLeft ]
    tell [ CropsDestroyed cost ]
    return $ Just ()

Final step is to roll a percentile die against given odds and see what happens. In case of Success, we record that worms were removed and value of function will be Just RemoveOriginalEvent. If we didn’t beat the odds, WormsStillPresent gets recorded and value of function is Just KeepOriginalEvent. Return value will then be used later to mark special event handled.

removeNews :: ( PersistStoreWrite backend, MonadIO m, BaseBackend backend ~ SqlBackend ) =>
              PercentileChance -> MaybeT (WriterT [KragiiResults] (ReaderT backend m)) EventRemoval
removeNews odds = MaybeT $ do
res <- liftIO $ roll odds
    case res of
        Success -> do
            _ <- tell [ WormsRemoved ]
            return $ Just RemoveOriginalEvent
        Failure -> do
            _ <- tell [ WormsStillPresent ]
            return $ Just KeepOriginalEvent

So result of this whole matter is:

( [KragiiResults], Maybe EventRemoval )

and whole lot of database activity.

Handling events during simulation

Pieces are now in place, time to put things in motion. When handling special events for a faction, first step is to load all unhandled ones and then call handleSpecialEvent for each of them.

handleFactionEvents :: (BaseBackend backend ~ SqlBackend
                       , PersistStoreWrite backend, PersistQueryRead backend
                       , PersistQueryWrite backend, MonadIO m) =>
                       Time -> Entity Faction -> ReaderT backend m [Key News]
handleFactionEvents date faction = do
    loadedMessages <- selectList [ NewsFactionId ==. (entityKey faction)
                                 , NewsSpecialEvent ==. UnhandledSpecialEvent ] [ Desc NewsDate ]
    let specials = mapMaybe extractSpecialNews $ parseNewsEntities loadedMessages
    mapM (handleSpecialEvent (entityKey faction) date) specials

resolveEvent resolves event based on choice user maybe made (this is what we explored earlier in the episode). Depending on the result of resolveEvent, event gets marked to handled and dismissed. In any case, a news article spelling out what happend is created and saved.

handleSpecialEvent :: (PersistQueryWrite backend, MonadIO m
                      , BaseBackend backend ~ SqlBackend) =>
                      Key Faction -> Time -> (Key News, SpecialNews) -> ReaderT backend m (Key News)
handleSpecialEvent fId date (nId, (KragiiWorms event _ choice)) = do
    (removal, results) <- resolveEvent (nId, event) choice
    _ <- when (removal /= Just KeepOriginalEvent) $
                    updateWhere [ NewsId ==. nId ]
                                [ NewsSpecialEvent =. HandledSpecialEvent
                                , NewsDismissed =. True ]
    insert $ report fId date event choice results

Result article creation is abstracted by ResultReport type class. It has single function report that takes parameters: database key of the faction the event concerns of, current time, special event that was processed, choice that was made and list of records telling what happened during resolution. It will return News that is ready to be saved into database.

class ResultsReport a b c | a -> b, a -> c where
report :: Key Faction -> Time -> a -> Maybe b -> [c] -> News
  • quite long and verbose instance
  • essentially take event, choice and results and build a string explaining what actually happened
  • <> is monoid operation for combining things, here used for text

Instance declaration is pretty long, because there’s many different cases to account for and by definition they’re all pretty verbose. I have included it in its entirity below, as it might be interesting to glance over and see different kinds of combinations that resolution might create.

instance ResultsReport KragiiWormsEvent KragiiWormsChoice KragiiResults where
    report fId date event choice results =
        let
            content = KragiiNews { kragiiNewsPlanetId = kragiiWormsPlanetId event
                                 , kragiiNewsPlanetName = kragiiWormsPlanetName event
                                 , kragiiNewsSystemId = kragiiWormsSystemId event
                                 , kragiiNewsSystemName = kragiiWormsSystemName event
                                 , kragiiNewsExplanation = repText
                                 , kragiiNewsDate = timeCurrentTime date
                                 }
        in
            mkNews fId date $ KragiiResolution content
        where
            repText = header choice <> " " <> removed choice (WormsRemoved `elem` results) <> " " <> injury <> " " <> destruction <> " "

            header (Just EvadeWorms) = "Local farmers had chosen to work on their fields, while avoiding the kragii worms."
            header (Just AttackWorms) = "Local farmers had decided to attack the worms with chemicals and burning."
            header (Just TameWorms) = "Decision to try and tame the kragii had been taken."
            header Nothing = "No decision what to do about worms had been taken."

            removed (Just EvadeWorms) True = "After some time, there has been no new kragii sightings and it seems that the threat is now over."
            removed (Just AttackWorms) True = "Attacks seem to have worked and there has been no new kragii sightings."
            removed (Just TameWorms) True = "Kragii has been tamed and put into use of improving soil quality."
            removed Nothing True = "Despite farmers doing nothing at all about the situation, kragii worms disappeared eventually."
            removed (Just EvadeWorms) False = "Kragii are still present on the planet and hamper farming operations considerability."
            removed (Just AttackWorms) False = "Despite the best efforts of farmers, kragii threat is still present."
            removed (Just TameWorms) False = "Taming of the worms was much harder than anticipated and they remain wild."
            removed Nothing False = "While farmers were debating best course of action, kragii reigned free and destroyed crops."

            injury = if FarmersInjured `elem` results
                        then "Some of the personnel involved in the event were seriously injured."
                        else "There are no known reports of personnel injuries."

            totalDestroyed = mconcat $ map (x -> case x of
                                                    CropsDestroyed n -> n
                                                    _ -> mempty) results
            destruction = if totalDestroyed > RawResource 0
                            then "In the end, " <> pack (show (unRawResource totalDestroyed)) <> " units of harvest was destroyed."
                            else "Despite of all this, no harvest was destroyed."

While there are still pieces left that need a bit work or are completely missing, the overall structure is in place. While this one took quite a bit of work to get working, I’m hoping that the next special event will be a lot easier to implement. Thanks for listening the episode.

Easiest way to catch me nowdays is either via email or on fediverse where I’m tuturto@mastodon.social


hpr2733 :: Writing Web Game in Haskell - News and Notifications

Released on 2019-01-23 under a CC-BY-SA license.

Intro

News and notifications are used in the game to let the players know something noteworthy has happened. It could be discovery of a new planet or construction project finally finishing.

All relevant information in the news is hyperlinked. If news mentions a planet, player can click the link and view current information of that planet.

Server interface

Server has three resources for news, although we’re concentrating only one here:

/api/message           ApiMessageR      GET POST
/api/message/#NewsId   ApiMessageIdR    DELETE
/api/icon              ApiMessageIcons  GET

First one is for retrieving all messages and posting a new one. Second one is for marking one read and third one is for retrieving all icons that players can attach to messages written by them.

Database

Database is defined in /config/models file. For news, there’s only one table:

News json
    content Text
    factionId FactionId
    date Int
    dismissed Bool
deriving Show Read Eq

Content field contains the actual news article data as serialized JSON. This allows storing complex data, without having to have lots of columns or multiple tables.

Domain objects

There are many kinds of messages that players might see, but we’ll concentrate on one about discovering a new planet

All different kinds of articles are of same type: NewsArticle. Each different kind of article has their own value constructor (PlanetFound in this particular case). And each of those value constructors has single parameter of a specific type that holds information particular to that certain article (PlanetFoundNews in this case). Adding a new article means adding a new value constructor and record to hold the data.

data NewsArticle =
    StarFound StarFoundNews
    | PlanetFound PlanetFoundNews
    | UserWritten UserWrittenNews
    | DesignCreated DesignCreatedNews
    | ConstructionFinished ConstructionFinishedNews


data PlanetFoundNews = PlanetFoundNews
    { planetFoundNewsPlanetName :: Text
    , planetFoundNewsSystemName :: Text
    , planetFoundNewsSystemId   :: Key StarSystem
    , planetFoundNewsPlanetId   :: Key Planet
    , planetFoundNewsDate       :: Int
    }

Given a News object, we can turn it into NewsArticle. These are much nicer to deal with that densely packed News that is stored in database:

parseNews :: News -> Maybe NewsArticle
parseNews =
    decode . toLazyByteString . encodeUtf8Builder . newsContent

Because parsing arbitrary JSON might fail, we get Maybe NewsArticle, instead of NewsArticle. It is possible to write the same code in longer way:

parseNews news =
    let
        content = newsContent news
        utf8Encoded = encodeUtf8Builder content
        byteString = toLazyByteString utf8Encoded
    in
        decode byteString

Similarly there’s two other functions for dealing with Entities (primary key, data - pair really) and list of Entities. Note that parseNewsEntities filters out all News that it didn’t manage to turn into NewsArticle. They have following signatures:

parseNewsEntity :: Entity News -> (Key News, Maybe NewsArticle)

parseNewsEntities :: [Entity News] -> [(Key News, NewsArticle)]

Writing JSON encoding and decoding is tedious, template Haskell can help us here:

$(deriveJSON defaultOptions ''PlanetFoundNews)
$(deriveJSON defaultOptions ''NewsArticle)

Turning Articles into JSON

News articles aren’t much use if they stay on the server, we need to send them to clients too. We can’t have multiple declarations of same typeclass for any type, so we declare complete new type and copy data there before turning it into JSON and sending to client (this is one way of doing this).

First step, define our types (concentrating on planet found news here):

data NewsArticleDto =
    StarFoundDto StarFoundNewsDto
    | PlanetFoundDto PlanetFoundNewsDto
    | UserWrittenDto UserWrittenNewsDto
    | DesignCreatedDto DesignCreatedNewsDto
    | ConstructionFinishedDto ConstructionFinishedNewsDto
    deriving (Show, Read, Eq)

data PlanetFoundNewsDto = PlanetFoundNewsDto
    { planetFoundNewsDtoPlanetName :: Text
    , planetFoundNewsDtoSystemName :: Text
    , planetFoundNewsDtoSystemId   :: Key StarSystem
    , planetFoundNewsDtoPlanetId   :: Key Planet
    , planetFoundNewsDtoDate       :: Int
    }
    deriving (Show, Read, Eq)

We need way to move data into dto and thus define a type class for that operation:

class (ToJSON d) => ToDto c d | c -> d where
    toDto :: c -> d

For more information about functional dependencies, check following links: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#extension-FunctionalDependencies and https://wiki.haskell.org/Functional_dependencies

Writing instances for our type class:

instance ToDto PlanetFoundNews PlanetFoundNewsDto where
    toDto news =
        PlanetFoundNewsDto { planetFoundNewsDtoPlanetName = planetFoundNewsPlanetName news
                           , planetFoundNewsDtoSystemName = planetFoundNewsSystemName news
                           , planetFoundNewsDtoSystemId = planetFoundNewsSystemId news
                           , planetFoundNewsDtoPlanetId = planetFoundNewsPlanetId news
                           , planetFoundNewsDtoDate = planetFoundNewsDate news
                           }

instance ToDto NewsArticle NewsArticleDto where
    toDto news =
        case news of
            (StarFound x) -> StarFoundDto $ toDto x
            (PlanetFound x) -> PlanetFoundDto $ toDto x
            (UserWritten x) -> UserWrittenDto $ toDto x
            (DesignCreated x) -> DesignCreatedDto $ toDto x
            (ConstructionFinished x) -> ConstructionFinishedDto $ toDto x

Finally, we want to wrap our news into something that has all the common info (id and link to icon to show)

data NewsDto = NewsDto
    { newsDtoId    :: Key News
    , newsContents :: NewsArticleDto
    , newsIcon     :: Text
    }
    deriving (Show, Read, Eq)

IconMapper knows how to turn NewsArticleDto (in this case) to corresponding link to the icon. Notice how our ToDto instance includes IconMapper in addition to Key and NewsArticle:

instance ToDto ((Key News, NewsArticle), (IconMapper NewsArticleDto)) NewsDto where
    toDto ((nId, article), icons) =
        let
            content = toDto article
        in
        NewsDto { newsDtoId = nId
                , newsContents = content
                , newsIcon = runIconMapper icons content
                }

Sideshow: IconMapper

IconMapper is a function that knows how to retrieve url to icon that matches the given parameter (for example NewsArticleDto in this case):

newtype IconMapper a =
    IconMapper { runIconMapper :: a -> Text }

One possible implementation that knows how to deal with NewsArticleDto. We have two levels of hierarchicy here, because UserNewsDto has special rules for figuring out which icon to use:

iconMapper :: (Route App -> Text) -> IconMapper UserNewsIconDto -> IconMapper NewsArticleDto
iconMapper render userIconMapper =
    IconMapper $ article ->
        case article of
            PlanetFoundDto _->
                render $ StaticR images_news_planet_png

            UserWrittenDto details ->
                runIconMapper userIconMapper $ userWrittenNewsDtoIcon details
    ...

Back to JSON

I wrote ToJSON and FromJSON instances by hand, because I wanted full control on how the resulting JSON looks like. It’s possible to configure how template Haskell names fields for example, but I think that writing these out couple of times is good practice and makes sure that I understand what’s going on behind the scenes if I use template Haskell later.

instance ToJSON NewsDto where
    toJSON (NewsDto { newsDtoId = nId
                    , newsContents = contents
                    , newsIcon = icon }) =
        object [ "id" .= nId
               , "contents" .= contents
               , "tag" .= jsonTag contents
               , "icon" .= icon
               , "starDate" .= newsStarDate contents
               ]

instance ToJSON PlanetFoundNewsDto where
    toJSON (PlanetFoundNewsDto { planetFoundNewsDtoPlanetName = pName
                               , planetFoundNewsDtoSystemId = sId
                               , planetFoundNewsDtoPlanetId = pId
                               , planetFoundNewsDtoSystemName = sName
                               }) =
        object [ "planetName" .= pName
               , "systemName" .= sName
               , "planetId" .= pId
               , "systemId" .= sId
               ]

Time to put it all together

Handler function authenticates user, check they’re member of a faction and then loads all the news:

getApiMessageR :: Handler Value
getApiMessageR = do
    (_, _, fId) <- apiRequireFaction
    loadAllMessages fId

Loading messages involves multiple steps:

  • retrieve News from database
    • correct faction, not dismissed, sort by date
  • parse them into ( Key News, NewsArticle )
  • get Url render function
  • create mapper for user icons
  • map all NewsArticles into ( NewsArticleDto, IconMapper )
  • turn them into JSON and return that to client
loadAllMessages :: Key Faction -> HandlerFor App Value
loadAllMessages fId = do
    loadedMessages <- runDB $ selectList [ NewsFactionId ==. fId
                                         , NewsDismissed ==. False ] [ Desc NewsDate ]
    let parsedMessages = parseNewsEntities loadedMessages
    render <- getUrlRender
    let userIcons = userNewsIconMapper render
    return $ toJSON $ map (toDto . (flip (,) (iconMapper render userIcons))) parsedMessages


hpr2723 :: Using Elm in context of 4X game client

Released on 2019-01-09 under a CC-BY-SA license.

Original idea I had with my toy game project was to have Yesod render most of the user interface as static HTML and have as little client side scripting as possible. Later I realized that there would be parts with significant amount of client side code and it might be better if whole site was written in Elm.

Couple goals I had in my mind when I started this:

  • easy to work with
  • type safe
  • extensible
  • user authorization
    • regular player
    • administrator

Backend is written in Haskell and front end in Elm. Communication between them is via REST interface and most of the data is in JSON. All JSON encoding / decoding is centralized (more or less), same with initiating requests to server.

API Endpoints

End points used for REST calls are defined in single data type that captures their name and parameters. These are used when initiating requests, meaning there’s smaller chance of typo slipping through.

type Endpoint
    = ApiStarDate
    | ApiResources
    | ApiStarSystem
    | ApiStar
    | ApiPlanet
    | ApiPopulation PlanetId
    | ApiBuilding PlanetId
    | ApiConstructionQueue PlanetId
    | ApiConstruction Construction
    | ApiBuildingConstruction
    | ApiAvailableBuildings

For example, sending a GET request to retrieve all construction projects on a planet is done as:

Http.send (ApiMsgCompleted << ConstructionsReceived) (get (ApiConstructionQueue planetId) (list constructionDecoder))

GET Request is sent to ApiConstructionQueue endpoint and it has planetId as parameter. When server sends response, our program will parse content of it will be a list that is parsed with constructionDecoder and create “ApiMsgCompleted ConstructionsReceived” message with result of the parsing. Update function will process this and store list of constructions somewhere safe for further use.

Update function

Update function is in charge of reacting to messages (mouse clicks, page changes, responses from server). In a large program update function will quickly get big and unwieldy. Breaking it into smaller pieces (per page for example), will make maintenance easier. This way each page has their own message type and own update function to handle it. In addition there’s few extra ones (cleaning error display, processing API messages and reacting to page changes).

Same way as API end points are encoded in a type, pages are too:

type Route
    = HomeR
    | ProfileR
    | StarSystemsR
    | StarSystemR StarSystemId
    | PlanetR StarSystemId PlanetId
    | BasesR
    | FleetR
    | DesignerR
    | ConstructionR
    | MessagesR
    | AdminR
    | LogoutR
    | ResearchR

routeToString function is used to map Route into String, that can be placed in hyperlink. Below is an excerp:

routeToString : Route -> String
routeToString route =
    case route of
        HomeR ->
            "/home"

        StarSystemR (StarSystemId sId) ->
            "/starsystem/" ++ String.fromInt sId

        PlanetR (StarSystemId sId) (PlanetId pId) ->
            "/starsystem/" ++ String.fromInt sId ++ "/" ++ String.fromInt pId

Because mapping needs to be bi-directional (Route used to define content of a href and string from a href used to define Route), there’s mapping to other direction too:

routes : Parser (Route -> a) a
routes =
    oneOf
        [ map HomeR top
        , map ProfileR (s "profile")
        , map ResearchR (s "research")
        , map StarSystemsR (s "starsystem")
        , map StarSystemR (s "starsystem" </> starSystemId)
        , map PlanetR (s "starsystem" </> starSystemId </> planetId)
        , map BasesR (s "base")
        , map FleetR (s "fleet")
        , map DesignerR (s "designer")
        , map ConstructionR (s "construction")
        , map MessagesR (s "message")
        , map AdminR (s "admin")
        , map LogoutR (s "logout")
]

Result of parsing is Maybe Route, meaning that failure will return Nothing. Detecting and handling this is responsibility of the calling code, usually I just default to HomeR.

Borrowing from Yesod, client uses recursive function to define breadcrumb path. This is hierarchical view of current location in the application, allowing user to quickly navigate backwards where they came.

Breadcrumb path consists of segments that are tuple of (String, Maybe Route). String tells text to display and Route is possible parent route of the segment. This allows hierarchical definition: “Home / Star systems / Sol / Earth”. Because route has only (for example) PlanetId, we need to pass Model too, so that the data retrieved from server can be used to figure out what name such a planet has.

{-| Build complete breadcrumb path and wrap it in enclosing HTML
-}
breadcrumbPath : Model -> Html Msg

{-| Recursively build list of breadcrumbs from segments
Last one is plain text, while parents of it are links
-}
breadcrumb : Model -> Bool -> Route -> List (Html Msg)

{-| Get segment of given route in form of ( String, Maybe Route )
String denotes text describing the segment, Maybe Route is possible parent
-}
segment : Model -> Route -> ( String, Maybe Route )

hpr2713 :: Resources in 4x game

Released on 2018-12-26 under a CC-BY-SA license.

Raw resources are integral part for most 4x games. Here’s one way of modeling them in Haskell. I wanted a system that is easy to use, doesn’t require too much typing and is type safe.

RawResource is basic building block:

newtype RawResource a = RawResource { unRawResource :: Int }
    deriving (Show, Read, Eq)

It can be parametrised with anything, but I’m using three different types:

data Biological = Biological
data Mechanical = Mechanical
data Chemical = Chemical

Example of defining harvest being 100 units of biological raw resources:

  harvest :: RawResource Biological
  harvest = RawResource 100

Raw resources are often manipulated (added and subtracted mostly). Defining Num instance allows us to use them as numbers:

instance Num (RawResource t) where
    (+) (RawResource a) (RawResource b) = RawResource $ a + b
    (-) (RawResource a) (RawResource b) = RawResource $ a - b
    (*) (RawResource a) (RawResource b) = RawResource $ a * b
    abs (RawResource a) = RawResource $ abs a
    signum (RawResource a) = RawResource $ signum a
    fromInteger a = RawResource $ fromInteger a

For example, adding harvest to stock pile:

  stock :: RawResource Biological
  stock = RawResource 1000

  harvest :: RawResource Biological
  harvest = RawResource 100

  newStock = stock + harvest

Comparing size of two resource piles is common operation. Ord instance has methods we need for comparing:

instance Ord (RawResource t) where
    (<=) (RawResource a) (RawResource b) = a <= b

One function is enough, as rest is defined in terms of it. Sometimes (usually for reasons of optimization), one might want to define other functions too.

Another way to add bunch of resources of same type together is defining Monoid instance:

instance Semigroup (RawResource t) where
    (<>) a b = a + b

instance Monoid (RawResource t) where
    mempty = RawResource 0

For example, combining harvests of many fields can be achieved as:

  harvests :: [RawResource Biological]
  harvests = [RawResource 20, RawResource 50, RawResource 25]

  total :: RawResource Biological
  total = mappend harvests

All these functions keep track of type of resources being manipulated. Compiler will emit an error if two different types of resources are being mixed together.

Raw resources are often grouped together for specific purpose. This again uses phantom types to keep track the intended usage:

data RawResources a = RawResources
    { ccdMechanicalCost :: RawResource Mechanical
    , ccdBiologicalCost :: RawResource Biological
    , ccdChemicalCost :: RawResource Chemical
    } deriving (Show, Read, Eq)

data ResourceCost = ResourceCost
data ConstructionSpeed = ConstructionSpeed
data ConstructionLeft = ConstructionLeft
data ConstructionDone = ConstructionDone
data ResourcesAvailable = ResourcesAvailable

And in order to be able to combine piles of RawResources, we’ll define Semigroup and Monoid instances. Notice how both instances make use of Semigroup and Monoid instances of RawResource:

instance Semigroup (RawResources t) where
    (<>) a b = RawResources
        { ccdMechanicalCost = ccdMechanicalCost a <> ccdMechanicalCost b
        , ccdBiologicalCost = ccdBiologicalCost a <> ccdBiologicalCost b
        , ccdChemicalCost = ccdChemicalCost a <> ccdChemicalCost b
        }

instance Monoid (RawResources t) where
    mempty = RawResources
        { ccdMechanicalCost = mempty
        , ccdBiologicalCost = mempty
        , ccdChemicalCost = mempty
        }

For those interested seeing some code, source is available at https://github.com/tuturto/deep-sky/ (https://github.com/tuturto/deep-sky/tree/baa0807dd36b61fd02174b17c10013862af4ec18 is situation before lots of Elm related changes that I mentioned in passing in the previous episode)


hpr2703 :: Fog of war in Yesod based game

Released on 2018-12-12 under a CC-BY-SA license.

Duality of the universe: there's true state of the universe used in simulation and there's state the the players perceive. These most likely will always be in conflict. One possible solution is to separate these completely. Perform simulation in one system and record what players see in other.

For every type of entity in the game, there's two sets of data: real and reported. Reports are tied to time and faction. Examples are given for planets. Thus, we have Planet, PlanetReport and CollatedPlanetReport. First is the real entity, second is report of that entity tied in time and faction. Third one is aggregated information a faction has of given entity. In database two first ones are:


Planet json
    name Text
    position Int
    starSystemId StarSystemId
    ownerId FactionId Maybe
    gravity Double
    SystemPosition starSystemId position
    deriving Show

PlanetReport json
    planetId PlanetId
    ownerId  FactionId Maybe
    starSystemId StarSystemId
    name Text Maybe
    position Int Maybe
    gravity Double Maybe
    factionId FactionId
    date Int
    deriving Show

Third one is defined as a datatype:


data CollatedPlanetReport = CollatedPlanetReport
    { cprPlanetId :: Key Planet
    , cprSystemId :: Key StarSystem
    , cprOwnerId  :: Maybe (Key Faction)
    , cprName     :: Maybe Text
    , cprPosition :: Maybe Int
    , cprGravity  :: Maybe Double
    , cprDate     :: Int
    } deriving Show

Data from database need to be transformed before working on it. Usually it's 1:1 mapping, but sometimes it makes sense to enrich it (turning IDs into names for example). For this we use ReportTransform type class:


-- | Class to transform a report stored in db to respective collated report
class ReportTransform a b where
    fromReport :: a -> b

instance ReportTransform PlanetReport CollatedPlanetReport where
    fromReport report =
	CollatedPlanetReport (planetReportPlanetId report)
			     (planetReportStarSystemId report)
			     (planetReportOwnerId report)
			     (planetReportName report)
			     (planetReportPosition report)
			     (planetReportGravity report)
			     (planetReportDate report)

To easily combine bunch of collated reports together, we define instances of semigroup and monoid for collated report data. Semigroup defines an associative binary operation (<>) and monoid defines a zero or empty item (mempty). My explanation about Monoid and Semigroup were a bit rambling, so maybe have a look at https://wiki.haskell.org/Monoid which explains it in detail.


instance Semigroup CollatedPlanetReport where
    (<>) a b = CollatedPlanetReport (cprPlanetId a)
				    (cprSystemId a)
				    (cprOwnerId a <|> cprOwnerId b)
				    (cprName a <|> cprName b)
				    (cprPosition a <|> cprPosition b)
				    (cprGravity a <|> cprGravity b)
				    (max (cprDate a) (cprDate b))

instance Monoid CollatedPlanetReport where
    mempty = CollatedPlanetReport (toSqlKey 0) (toSqlKey 0) Nothing Nothing Nothing Nothing 0

In some cases there might be a list of collated reports that are about different entities of same type (several reports for every planet in solar system). For those cases, we need a way to tell what reports belong together:


-- | Class to indicate if two reports are about same entity
class Grouped a where
    sameGroup :: a -> a -> Bool

instance Grouped PlanetReport where
    sameGroup a b =
	planetReportPlanetId a == planetReportPlanetId b

After this, processing a list of reports for same entity is short amount of very general code:


-- | Combine list of reports and form a single collated report
--   Resulting report will have facts from the possibly partially empty reports
--   If a fact is not present for a given field, Nothing is left there
collateReport :: (Monoid a, ReportTransform b a) => [b] -> a
collateReport reports = mconcat (map fromReport reports)

For reports of multiple entities is bit more complex, as they need to be sorted first, but the code is similarly general:


-- | Combine list of reports and form a list of collated reports
--   Each reported entity is given their own report
collateReports :: (Grouped b, Monoid a, ReportTransform b a) => [b] -> [a]
collateReports [] = []
collateReports s@(x:_) = collateReport itemsOfKind : collateReports restOfItems
    where split = span (sameGroup x) s
	  itemsOfKind = fst split
	  restOfItems = snd split

Final step is to either render reports as HTML or send them as JSON back to client. For JSON case we need one more type class instance (ToJSON) that can be automatically generated. After that handler function can be defined. After authenticating the user and checking that they are member of a faction, reports of specific planet (defined by its primary key) are retrieved from database, collated, turned into JSON and sent back to client:


$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''CollatedPlanetReport)

getApiPlanetR :: Key Planet -> Handler Value
getApiPlanetR planetId = do
    (_, _, fId) <- apiRequireFaction
    loadedPlanetReports <- runDB $ selectList [ PlanetReportPlanetId ==. planetId
					      , PlanetReportFactionId ==. fId ] [ Asc PlanetReportDate ]
    let planetReport = collateReport $ map entityVal loadedPlanetReports :: CollatedPlanetReport
    return $ toJSON planetReport

For those interested seeing some code, source is available at https://github.com/tuturto/deep-sky/ (https://github.com/tuturto/deep-sky/tree/baa0807dd36b61fd02174b17c10013862af4ec18 is situation before lots of Elm related changes that I mentioned in passing in the previous episode)


hpr2693 :: Getting started with web based game in Haskell and Elm

Released on 2018-11-28 under a CC-BY-SA license.

Haskell Stack: https://docs.haskellstack.org/en/stable/README/

Stack is a build tool for Haskell with focus on reproducible build plans, multi-package projects, and a consistent, easy-to-learn interface. With stack, one can create new project: stack new my-project yesod-sqlite (more in the quick start guide: https://www.yesodweb.com/page/quickstart)

models is used to define shape of the data and Yesod uses it to generate datatypes and database for you. For example, to define a Star that has name, spectral type, luminosity class and link to StarSystem, one can write:


Star json
    name Text
    starSystemId StarSystemId
    spectralType SpectralType
    luminosityClass LuminosityClass

Custom types, like LuminosityClass, need mapping between datatype and database. In simple cases like this, Yesod can do that:


data LuminosityClass = Iap | Ia | Iab | Ib | II | III | IV | V | VI | VII
    deriving (Show, Read, Eq)
derivePersistField "LuminosityClass"

The "derivePersistField" part is template haskell call that will generate mapping needed.

For those interested seeing some code, source is available at https://github.com/tuturto/deep-sky/ (https://github.com/tuturto/deep-sky/tree/baa0807dd36b61fd02174b17c10013862af4ec18 is situation before lots of Elm related changes that I mentioned in passing in the episode)


hpr2633 :: Elm - First Impressions

Released on 2018-09-05 under a CC-BY-SA license.

hpr2618 :: Yesod - First Impressions

Released on 2018-08-15 under a CC-BY-SA license.

First place to start is probably Yesod’s web site at: https://www.yesodweb.com/

Often recommended environment for developing Haskell programs is Stack: https://docs.haskellstack.org/en/stable/README/

My road to Haskell started with Learn You a Haskell for Great Good: http://learnyouahaskell.com/ and going through lecture notes of CIS 194: http://www.seas.upenn.edu/%7Ecis194/spring13/lectures.html


hpr2608 :: BattleTech

Released on 2018-08-01 under a CC-BY-SA license.

Following links might help you to get more familiar with the game.


hpr2598 :: Calculating planetary orbits in Haskell

Released on 2018-07-18 under a CC-BY-SA license.

Function signatures (it might or might not be helpful to have these at hand while listening):

  • Helpers:
    radToDeg :: Floating a => a -> a
    degToRad :: Floating a => a -> a
    clamp :: Float -> Float
  • Time:

    day :: Int -> Int -> Int -> Float -> Day Float
  • Orbital parameters:
    longitudeOfAscendingNode :: Orbit body center => body -> center -> Day d -> LongAscNode body center
    inclinationToEcliptic :: Orbit body center => body -> center -> Day d -> InclToEcl body center
    argumentOfPeriapsis :: Orbit body center => body -> center -> Day d -> ArgPeri body center
    semiMajorAxis :: Orbit body center => body -> center -> Day d -> SemiMajor body center
    eccentricity :: Orbit body center => body -> center -> Day d -> Ecc body center
    meanAnomaly :: Orbit body center => body -> center -> Day d -> MeanAno body center
  • Calculating location on orbital plane:
    eccAnomaly :: MeanAno a b -> Ecc a b -> EccAnomaly a b
    trueAnomaly :: EccAnomaly a b -> Ecc a b -> TrueAnomaly a b
    dist :: EccAnomaly a b -> Ecc a b -> SemiMajor a b -> Distance a b
  • Translating between coordinate systems:
    toEclCoord :: TrueAnomaly a b -> Distance a b -> LongAscNode a b -> ArgPeri a b -> InclToEcl a b -> EclCoord a b
    toEqCoordinates :: EclCoord body Earth -> Day Float -> EqCoord body

Some helpful links:


hpr2593 :: Intro to De Bellis Antiquitatis

Released on 2018-07-11 under a CC-BY-SA license.

In this episode tuturto paints rambles about De Bellis Antiquitatis while painting more toy soldiers, so expect long pauses and missing thoughts as he tries to do two things at the same time.

De Bellis Antiquitatis (or DBA for short): https://en.wikipedia.org/wiki/De_Bellis_Antiquitatis

While the original site seems to be gone, WADBAG unofficial guide to DBA can be found at: http://www.wargames-romania.ro/wordpress/wargames/de-bellis-antiquitatis-dba/the-unofficial-guide-to-dba/


hpr2588 :: Miniature painting

Released on 2018-07-04 under a CC-BY-SA license.

tuturto rambles about miniature painting while painting some ancient British units (horses for chariots to be specific) for De Bellis Antiquitatis.


hpr2524 :: General problem solver

Released on 2018-04-05 under a CC-BY-SA license.

Become a Correspondent