Site Map - skip to main content

Hacker Public Radio

Your ideas, projects, opinions - podcasted.

New episodes every weekday Monday through Friday.
This page was generated by The HPR Robot at

hpr2828 :: Writing Web Game in Haskell - Science, part 2

Tuula continues their explanation on simulating science in a game written in Haskell

<< First, < Previous, , Latest >>

Thumbnail of Tuula
Hosted by Tuula on 2019-06-05 is flagged as Clean and is released under a CC-BY-SA license.
haskell. (Be the first).
The show is available on the Internet Archive at:

Listen in ogg, spx, or mp3 format. Play now:

Duration: 00:45:34


A series looking into the Haskell (programming language)


Last time we looked how to model technology and research. This time we’ll do some actual research. I’m skipping over some of the details as the episode is long enough as it is. Hopefully it’s still possible to follow with the show notes.

Main concepts that I’m mentioning: Technology allows usage of specific buildings, ship components and such. Research unlock technologies and may have antecedents that has to be completed before the research can be started. Research cost is measure of how expensive a research is in terms of research points, which are produced by different buildings.

Earlier I modeled tech tree as Map that had Technology as keys and Research as values. I realized that this is suboptimal and will replace it at some point in the future.

Server API

There’s three resources that client can connect to. First one is for retrieving list of available research, second one for manipulating current research and last one for retrieving info on how much research points is being produced.

/api/research/available     ApiAvailableResearchR       GET
/api/research/current       ApiCurrentResearchR         GET POST DELETE
/api/research/production    ApiResearchProductionR      GET


Simulation of research is done by handleFactionResearch, which does simulation for one faction for a given date. After calculating current research point production and retrieving list of current research, function calculates progress of current researches. Unfinished ones are written back to database, while completed are moved into completed_research table. Final step is updating what research will be available in the next turn.

handleFactionResearch date faction = do
    production <- totalProduction $ entityKey faction
    current <- selectList [ CurrentResearchFactionId ==. entityKey faction ] []
    let updated = updateProgress production <$> current
    _ <- updateUnfinished updated
    _ <- handleCompleted date updated $ entityKey faction
    _ <- updateAvailableResearch $ entityKey faction
    return ()

Research point production

Research points are produced by buildings. So first step is to load all planets owned by the faction and buildings on those planets. Applying researchOutput function to each building yields a list of TotalResearchScore, which is then summed up by mconcat. We can use mconcat as TotalResearchScore is a monoid (I talked about these couple episodes ago).

totalProduction fId = do
    pnbs <- factionBuildings fId
    let buildings = join $ fmap snd pnbs
    return $ mconcat $ researchOutput . entityVal <$> buildings

researchOutput function below uses pattern matching. Instead of writing one function definition and case expression inside of it, we’re writing multiple definitions. Each of them matches building of different type. First example is definition that is used for ResearchComplex, while second one is for ParticleAccelerator. Final case uses underscore to match anything and indicate that we’re not even interested on the particular value being matched. mempty is again from our monoid definition. It is empty or unit value of monoid, which in case of TotalResearchScore is zero points in all research categories.

researchOutput Building { buildingType = ResearchComplex } =
    { totalResearchScoreEngineering = ResearchScore 10
    , totalResearchScoreNatural = ResearchScore 10
    , totalResearchScoreSocial = ResearchScore 10

researchOutput Building { buildingType = ParticleAccelerator } =
    { totalResearchScoreEngineering = ResearchScore 15
    , totalResearchScoreNatural = ResearchScore 15
    , totalResearchScoreSocial = ResearchScore 0

researchOutput _ = mempty

Updating progress

Moving research forward is more complex looking function. There’s bunch of filtering and case expressions going on, but the idea is hopefully clear after a bit of explanation.

updateProgress takes two parameters, total production of research points and current research that is being modified. This assumes that there are only one of each categories of research going on at any given time. If there were more, we would have to divide research points between them by some logic. Function calculates effect of research points on current research and produces a new current research that is the end result.

Perhaps the most interesting part is use of lenses. For example, line entityValL . currentResearchProgressL +~ engResearch $ curr means that curr (which is Entity CurrentResearch) is used as starting point. First we reach to data part of Entity and then we focus on currentResearchProgress and add engResearch to it. This results a completely new Entity CurrentResearch being constructed, which is otherwise identical with the original, but the currentResearchProgress has been modified. Without lenses we would have to do this destructuring and restructuring manually.

updateProgress :: TotalResearchScore ResearchProduction -> Entity CurrentResearch -> Entity CurrentResearch
updateProgress prod curr =
    case researchCategory <$> research of
        Just (Engineering _) ->
            entityValL . currentResearchProgressL +~ engResearch $ curr

        Just (NaturalScience _) ->
            entityValL . currentResearchProgressL +~ natResearch $ curr

        Just (SocialScience _) ->
            entityValL . currentResearchProgressL +~ socResearch $ curr

        Nothing ->
        research = Map.lookup (currentResearchType . entityVal $ curr) techMap
        engResearch = unResearchScore $ totalResearchScoreEngineering prod
        natResearch = unResearchScore $ totalResearchScoreNatural prod
        socResearch = unResearchScore $ totalResearchScoreSocial prod

Writing unfinished research back to database is short function. First we find ones that hasn’t been finished by filtering with (not . researchReady . entityVal) and then we apply replace to write them back one by one.

updateUnfinished updated = do
    let unfinished = filter (not . researchReady . entityVal) updated
    mapM (\x -> replace (entityKey x) (entityVal x)) unfinished

Handling finished research starts by finding out which ones were actually completed by filtering with (researchReady . entityVal) and their research type with currentResearchType . entityVal. Rest of the function is all about database actions: creating entries into completed_research and adding news entries for each completed research, then removing entries from current_research and available_research.

handleCompleted date updated fId = do
    let finished = filter (researchReady . entityVal) updated
    let finishedTech = currentResearchType . entityVal <$> finished
    insertMany_ $ currentToCompleted date . entityVal <$> finished
    insertMany_ $ researchCompleted date fId . (currentResearchType . entityVal) <$> finished
    deleteWhere [ CurrentResearchId <-. fmap entityKey finished ]
    deleteWhere [ AvailableResearchType <-. finishedTech
                , AvailableResearchFactionId ==. fId ]

Available research

Figuring out what researches will be available for the next turn takes several steps. I won’t be covering random numbers in detail, they’re interesting enough for an episode on their own. It’s enough to know that g <- liftIO getStdGen gets us a new random number generator that is seeded by current time.

updateAvailableResearch starts by loading available research and current research for the faction and initializing a new random number generator. g can be used multiple times, but it’ll always return same sequence of numbers. Here it doesn’t matter, but in some cases it might. getR is helper function I wrote that uses random number generator to pick n entries from a given list. n in our case is hard coded to 3, but later on I’ll add possibility for player to research technologies that raise this limit. newAvailableResearch (we’ll look into its implementation closer just in a bit) produces a list of available research for specific research category. These lists are combined with <> operator and written into database with rewriteAvailableResearch.

updateAvailableResearch fId = do
    available <- selectList [ AvailableResearchFactionId ==. fId ] []
    completed <- selectList [ CompletedResearchFactionId ==. fId ] []
    g <- liftIO getStdGen
    let maxAvailable = ResearchLimit 3
    -- reusing same g should not have adverse effect here
    let engCand = getR g (unResearchLimit maxAvailable) $ newAvailableResearch isEngineering maxAvailable available completed
    let natCand = getR g (unResearchLimit maxAvailable) $ newAvailableResearch isNaturalScience maxAvailable available completed
    let socCand = getR g (unResearchLimit maxAvailable) $ newAvailableResearch isSocialScience maxAvailable available completed
    rewriteAvailableResearch fId $ engCand <> natCand <> socCand

newAvailableResearch is in charge of figuring out what, if any, new research should be available in the next turn. In case where amount of currently available research is same or greater than research limit, empty list is returned, otherwise function calculates candidates and returns them. Logic for that is following:

  • candidates are research of specific category of those that has been unlock and unresearched
  • unlocked and unresearched are unlocked ones that are in list of known technology
  • unlocked research are ones with antecedents available in tech tree
  • known technology are ones in list of completed research

and complete definition of the function is shown below:

newAvailableResearch selector limit available completed =
    if ResearchLimit (length specificCategory) >= limit
        then []
        else candidates
        specificCategory = filter (availableResearchFilter selector) available
        candidates = filter (selector . researchCategory) unlockedAndUnresearched
        unlockedAndUnresearched = filter (\x -> researchType x `notElem` knownTech) unlockedResearch
        unlockedResearch = filter (antecedentsAvailable knownTech) $ unTechTree techTree
        knownTech = completedResearchType . entityVal <$> completed

availableResearchFilter f x =
    maybe False (f . researchCategory) res
        res = Map.lookup (availableResearchType $ entityVal x) techMap

Final step of the simulation of research is to update database with new available research. mkUniq is helper function that removes duplicate elements from a list. It’s used in rewriteAvailableResearch function to make a list that contains all unique top research categories (engineering, natural sciences and social sciences). If the resulting list isn’t empty, we’ll use it to remove all available research for those top categories and insert new available research.

rewriteAvailableResearch fId res = do
    let cats = mkUniq $ fmap (topCategory . researchCategory) res
    unless (null cats) $ do
        deleteWhere [ AvailableResearchFactionId ==. fId
                    , AvailableResearchCategory <-. cats ]
        insertMany_ $ researchToAvailable fId <$> res

Now everything is ready for next round of simulation.


Subscribe to the comments RSS feed.

Leave Comment

Note to Verbose Commenters
If you can't fit everything you want to say in the comment below then you really should record a response show instead.

Note to Spammers
All comments are moderated. All links are checked by humans. We strip out all html. Feel free to record a show about yourself, or your industry, or any other topic we may find interesting. We also check shows for spam :).

Provide feedback
Your Name/Handle:
Anti Spam Question: What does the letter P in HPR stand for?
Are you a spammer?
What is the HOST_ID for the host of this show?
What does HPR mean to you?