In-Depth Series

Haskell

Custom data with Persistent - tuturto | 2019-07-31

Podcast episode is about two things, serializing custom data with Persistent and IsString typeclass.

I’m using Persistent in conjunction with Yesod (web framework). Process in short is that data is defined in /config/models file that is used in compile time to generate data type definitions for Haskell. Same information is used to create schema for the database when Yesod application starts. It can even do simple migrations if schema changes, but I wouldn’t recommend using that in production.

Persistent maps information between database and program written in Haskell. There’s pre-existing mappings for things like text and various kinds of numbers. In case one wants to use custom data type, compiler can automatically generate needed mapping. This automatic generation works well with enumerations and very complex data.

For example, following piece defines enumeration BuildingType that is mapped in varchar field in database. Enumeration is thus stored as text.

data BuildingType = SensorStation
    | ResearchComplex
    | Farm
    | ParticleAccelerator
    | NeutronDetector
    | BlackMatterScanner
    | GravityWaveSensor
    deriving (Show, Read, Eq)

derivePersistField "BuildingType"

For newtypes, automatic deriving works too, but generates (in my opinion) extra information that isn’t needed. This extra information causes data saved as text. For those cases, manual mapping can be used.

Our example is for StarDate, which is just glorified Int. I’m using newtype to make StarDate distinct from any other Int, even when it behaves just like Int.

newtype StarDate = StarDate { unStarDate :: Int }
    deriving (Show, Read, Eq, Num, Ord)

instance PersistField StarDate where
    toPersistValue (StarDate n) =
        PersistInt64 $ fromIntegral n

    fromPersistValue (PersistInt64 n) =
        Right $ StarDate $ fromIntegral n

    fromPersistValue _ =
        Left "Failed to deserialize"


instance PersistFieldSql StarDate where
    sqlType _ = SqlInt64

One more trick, that doesn’t directly relate to Persistent is IsString type class. Instead of having to specify all the time what type text literal is, one can let compiler to deduce it from usage.

For example, if I had a newtype like:

newtype PlanetName = PlanetName { unPlanetName :: Text }

I can turn on OverloadedStrings pragma and create IsString instance:

instance IsString PlanetName where
    fromString = PlanetName . fromString

Now I can write: placeName = "Earth" instead of placeName = PlanetName "Earth" and compiler can deduce correct type based on how the placeName is used.

Thanks for listening, if you have any questions or comments, you can reach me via email or in the fediverse, where I’m tuturto@mastodon.social.

Vehicle designer for a space game - tuturto | 2019-07-17

This episode is about modeling vehicle designer that can be used to design all kinds of vehicles available in the game. It relates to episode about performing research.

Major parts

Two major parts about vehicle designer are components and chassis.

Components are modular pieces of vehicle that are assembled on chassis. They can, among other things, be things lie star sails, astrolabe navigators or long range sensor. Each component is defined by two values ComponentId and ComponentLevel. If you know these two values, you’ll be able to find out details of the component. ComponentId tells what component it is and ComponentLevel the general knowledge of it. When component is first discovered as a result of research, it’s just a prototype and as a such doesn’t function particularly well. Further research refines it and factories are able to produce higher quality components.

Full definition of component is show below:

data Component = Component
    { componentId :: ComponentId
    , componentLevel :: ComponentLevel
    , componentName :: ComponentName
    , componentDescription :: ComponentDescription
    , componentWeight :: Weight
    , componentSlot :: ComponentSlot
    , componentType :: [ ComponentPower ]
    , componentCost :: RawResources ResourceCost
    , componentChassisType :: ChassisType
    }
    deriving (Show, Read, Eq, Ord)

Two particularly interesting fields are componentSlot and componentType. componentSlot has type of ComponentSlot and defines what kind of slot the component occupies in chassis. As there are limited amount of slots in each chassis, designer needs to make compromises on what components to install. componentType has type of ComponentPower, which defines what component does in general. It could be sensor or provide supplies for the vehicle for example.

Technology requirements are defined by function: componentRequirements :: ComponentId -> Maybe Technology. It defines which technology unlock a given component. Part of the definition is show below. Each and every ComponentId has to be handled.

componentRequirements ShipLongRangeSensors = Just HighSensitivitySensors
componentRequirements ShipBridge = Nothing
componentRequirements VehicleWheeledMotiveSystem = Nothing
componentRequirements VehicleHoverMotiveSystem = Just HoverCrafts
...

Second major part of the designer are chassis. They’re stored in database, as I wanted a bit more flexible system than hardcoding as I did with components. Following piece of configuration is used to define database table and generated data for Haskell code. Most of the fields are probably easy enough to guess. type with type of ChassisType defines if this particular chassis is for example a land vehicle or a space ship. Various slot fields on other hand define amount of particular slots that the chassis offers.

Chassis json
    name ChassisName
    tonnage Weight
    type ChassisType
    technology Technology Maybe
    armourSlots SlotAmount
    innerSlots SlotAmount
    outerSlots SlotAmount
    sensorSlots SlotAmount
    weaponSlots SlotAmount
    engineSlots SlotAmount
    motiveSlots SlotAmount
    sailSlots SlotAmount
    deriving Show Read Eq

Not all chassis are equal and some (probably pretty much every one of them) have some sort of requirements that has to be fulfilled when designing a vehicle. For example, space ships require a bridge for captain and star sails. Bawley, smallest of the working ships has room for two star sails, but requires only one of them to be installed in order to be a valid design. Flyboat on the other hand is smaller ship built for speed and always requires two set of sails.

This data is stored in required_component table and represented as RequiredComponent data. Both are generated from the definition show below:

RequiredComponent json
    chassisId ChassisId
    componentType ComponentType
    level ComponentLevel
    amount ComponentAmount
    deriving Show Read Eq

Designing a vehicle

With all that data, we can now design a vehicle. Process is roughly the following:

• based on completed research, get a list of chassis that are available
• select chassis from the list
• based on the selected chassis and completed research, get a list of components that are available
• select components to install
• remember to check that maximum tonnage isn’t exceeded and that there’s enough slots and requirements are met
• fill in name
• save into database

Completed design is saved in two different tables. First one design holds info like name of the design, faction that design belongs to and used chassis. planned_component holds info about which components are planned to be installed and in what quantity.

Design json
    name Text
    ownerId FactionId
    chassisId ChassisId
    deriving Show Read Eq

and

PlannedComponent json
    designId DesignId
    componentId ComponentId
    level ComponentLevel
    amount ComponentAmount
    deriving Show Read Eq

As a little teaser, below is an screenshot of what the vehicle designer currently looks like.

Finally

Thanks for interest. If you have questions or comments, best way to reach me nowadays is either by email or in fediverse, where I’m tuturto@mastodon.social.

Random numbers in Haskell - tuturto | 2019-07-03

There’s lots of random and similar sounding words in this episode. I hope you can still follow what I’m trying to explain, but I’m aware that it might be hard.

Haskell functions are pure, meaning that they will always produce same values for same set of arguments. This might sound hard when you want to generate random numbers, but it turns out that the solution isn’t too tricky.

First part to the puzzle is type class RandomGen:

class RandomGen g where
    next :: g -> (Int, g)
    genRange :: g -> (Int, Int)
    split :: g -> (g, g)

next produces tuple, where first element is random Int and second element is new random generator. genRange returns tuple defining minimum and maximum values this generator will return. split produces tuple with two new random generators.

Using RandomGen to produce random values of specific type or for specific range requires a bit of arithmetic. It’s easier to use Random that defines functions for that specific task:

class Random a where
    randomR :: RandomGen g => (a, a) -> g -> (a, g)
    random :: RandomGen g => g -> (a, g)
    randomRs :: RandomGen g => (a, a) -> g -> [a]
    randoms :: RandomGen g => g -> [a]
    randomRIO :: (a, a) -> IO a
    randomIO :: IO a

• randomR, when given range and random generator, produces tuple with random number and new generator
• random, is similar but doesn’t take range. Instead it will use minimum and maximum specific to that data type
• randomRs, takes range and produces infinite list of random values within that range
• randoms, simply produces infinite list of random values using range that is specific to datatype
• randomRIO and randomIO are effectful versions that don’t need random generator, but use some default one

In short, RandomGen is source of randomness and Random is datatype specific way of generating random values using random generator RandomGen.

Final part of the puzzle is where to get RandomGen? One could initialize one manually, but then it wouldn’t be random. However, there’s function getStdGen that will seed RandomGen using OS default random number generator, current time or some other method. Since it has signature of getStdGen :: IO StdGen, one can only call it in IO monad.

Functions that operate with IO can only be called from other IO functions. They can call pure functions, but pure functions can’t call them. So there’s two options: have the code that needs random numbers in effectful function or get RandomGen in effectful function and pass it to pure function.

Example

import System.Random
import Data.List

-- | get n unique entries from given list in random order
-- | if n > length of list, all items of the list will be returned
getR :: RandomGen g => g -> Int -> [a] -> [a]
getR g n xs =
    fmap (xs !!) ids
    where
        ids = take (min n $ length xs) $ nub $ randomRs (0, length xs - 1) g

-- | Returns 4 unique numbers between 1 and 10 (inclusive)
test :: IO [Int]
test = do
    g <- getStdGen
    return $ getR g 4 [1..10]

In closing

Pseudo randomness doesn’t require IO, only seeding the generator does. Simple computation that don’t require many calls to random are easy enough. If you need lots of random values, MonadRandom is better suited. It takes care of carrying implicit RandomGen along while your computation progresses.

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

Why Haskell? - tuturto | 2019-06-19

I got really good comment on episode 2778 - Functor and applicative in Haskell from Beeza that I’m including below:

I’ve been writing software for over 30 years but I find the syntax of Haskell anything but intuitive - in fact less so than any other programming language I have looked at. Thanks to your excellent show notes I can make sense of it but I have to say I would not like to have to develop a project using this language.

Obviously I am missing the point as nobody would design a language with the intention of its being difficult to use. Perhaps you could produce another episode addressing the question “Why Haskell?”

In this episode, I’m trying to answer to that from my point of view.

Writing Web Game in Haskell - Science, part 2 - tuturto | 2019-06-05

Intro

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

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 } =
    TotalResearchScore
    { totalResearchScoreEngineering = ResearchScore 10
    , totalResearchScoreNatural = ResearchScore 10
    , totalResearchScoreSocial = ResearchScore 10
    }

researchOutput Building { buildingType = ParticleAccelerator } =
    TotalResearchScore
    { 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 ->
            curr
    where
        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
    where
        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
    where
        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.

Writing Web Game in Haskell - Science, part 1 - tuturto | 2019-05-22

Background

This is rather large topic, so I split it in two episodes. Next one should follow in two weeks if everything goes as planned. First part is about modeling research, while second part concentrates on how things change over time.

There’s three types of research: engineering, natural sciences and social sciences. Research costs points that are produced by various buildings.

Implementation

There’s three database tables, which are defined below:

CurrentResearch
    type Technology
    progress Int
    factionId FactionId

AvailableResearch
    type Technology
    category TopResearchCategory
    factionId FactionId

CompletedResearch
    type Technology
    level Int
    factionId FactionId
    date Int

Data types

Technology is enumeration of all possible technologies. Knowing these enable player to build specific buildings and space ships, enact various laws and so on. In the end this will be (hopefully) large list of technologies.

data Technology =
    HighSensitivitySensors
    | SideChannelSensors
    | HighTensileMaterials
    | SatelliteTechnology
    | BawleyHulls
    | SchoonerHulls
    | CaravelHulls
    ...
    deriving (Show, Read, Eq, Enum, Bounded, Ord)

All research belong to one of the top categories that are shown below:

data TopResearchCategory =
    Eng
    | NatSci
    | SocSci
    deriving (Show, Read, Eq, Ord)

ResearchCategory is more fine grained division of research. Each of the categories is further divided into sub-categories. Only EngineeringSubField is shown below, but other two are similarly divided.

data ResearchCategory =
    Engineering EngineeringSubField
    | NaturalScience NaturalScienceSubField
    | SocialScience SocialScienceSubField
    deriving (Show, Read, Eq)

data EngineeringSubField =
    Industry
    | Materials
    | Propulsion
    | FieldManipulation
    deriving (Show, Read, Eq)

ResearchScore is measure of how big some research is. It has type parameter a that is used to further quantify what kind of ResearchScore we’re talking about.

newtype ResearchScore a = ResearchScore { unResearchScore :: Int }
    deriving (Show, Read, Eq, Ord, Num)

TotalResearchScore is record of three different types of researches. I’m not sure if I should keep it as a record of three fields or if I should change it so that only one of those values can be present at any given time.

data TotalResearchScore a = TotalResearchScore
    { totalResearchScoreEngineering :: ResearchScore EngineeringCost
    , totalResearchScoreNatural :: ResearchScore NaturalScienceCost
    , totalResearchScoreSocial :: ResearchScore SocialScienceCost
    }
    deriving (Show, Read, Eq)

Following singleton values are used with ResearchScore and TotalResearchScore to quantify what kind of value we’re talking about.

data EngineeringCost = EngineeringCost
    deriving (Show, Read, Eq)

data NaturalScienceCost = NaturalScienceCost
    deriving (Show, Read, Eq)

data SocialScienceCost = SocialScienceCost
    deriving (Show, Read, Eq)

data ResearchCost = ResearchCost
    deriving (Show, Read, Eq)

data ResearchProduction = ResearchProduction
    deriving (Show, Read, Eq)

data ResearchLeft = ResearchLeft
    deriving (Show, Read, Eq)

Finally there’s Research, which is a record that uses many of the types introduced earlier. It describes what Technology is unlocked upon completion, what’s the cost is and if there are any technologies that have to have been researched before this research can start. The tier of research isn’t currently used for anything, but I have vague plans what to do about it in the future.

data Research = Research
    { researchName :: Text
    , researchType :: Technology
    , researchCategory :: ResearchCategory
    , researchAntecedents :: [Technology]
    , researchCost :: TotalResearchScore ResearchCost
    , researchTier :: ResearchTier
    }
    deriving (Show, Read, Eq)

Tech tree

Putting all this together, we can define a list of Research. Since finding an entry from this list based on research type of it is such a common operation, we also define another data structure for this specific purpose. Map in other programming languages is often known as dictionary, associative array or hash map. It stores key-value - pairs. In our case Technology is used as key and Research as value. We define it based on the list previously defined:

techMap :: Map.Map Technology Research
techMap = Map.fromList $ (\x -> (researchType x, x)) <$> unTechTree techTree

Next time we’ll look into how to actually use all these types and data that were defined.

Haskell function types - tuturto | 2019-05-08

Haskell is statically typed language, meaning that during compilation, programs are checked for type correctness. This means that you won’t accidentally mix for example text and numbers. Haskell does type inference. The compiler will try and figure out what kind of types would make your program to be valid in terms of types. Programmer could completely omit types, but it’s often helpful to write type signatures for at least top level definitions. These will be helpful for both the programmers and compilers.

concrete types

Simplest case is where types are spelled out definitely. Function add below takes two Integer parameters and produces Integer value. Note that types are written in upper case.

add :: Integer -> Integer -> Integer

It’s possible to not use concrete types. In following example a (note the lower case) can be anything. So function takes two values of a, a Boolea and produces a. This is useful technique for writing very general functions.

choose :: a -> a -> Boolean -> a

ad hoc polymorphism

In previous example, we wouldn’t be able to do much at all with a as we don’t know its type. Sometimes we need to know a bit more about type, without specifically declaring its type. For those cases type constraints are useful.

add :: (Num a) => a -> a -> a

This version of add again takes two parameters, both being type a and produces value a. But (Num a) => part in the signature constraints a to be instance of Num. This type class (I’ll talk about these some other time) defines that each instance of it will have set of functions: +, -, *, negate, abs, signum and fromInteger. So now our add function can use those functions, regardless of what specific type a is.

parametrized functions

Types used in function signature can be parametrized. If we wanted a function that returns a first element of any list, we could have following signature: first :: [a] -> Maybe a

first takes single parameter, list of a and returns Maybe a. Maybe is a type that is used to signify a value that might or might not be present and has following definition:

data Maybe a =
     Nothing
     | Just a

So our function would return Nothing when given an empty list and Just a when given a list of at least one element.

using functions

Function application in Haskell doesn’t require parentheses around arguments. Calling our add function is just add 1 2. If one of the values is result of another function call, we need to tell which parameters belong to which function. Using $ is one option: add 1 $ add 2 3, another option is to use parentheses: add 1 (add 2 3).

When function is called with less parameters than it expect, instead of run time error you’ll going to receive a function. In following example addLots 5 will produce same value as add 1000 5:

addLots = add 1000
addLots 5

Another contrived example of partial application:

findPodcasts :: [Podcast] -> Text -> [Podcast]
search = findPodcasts loadedPodcasts
myPodcasts = search "tuturto"

functions as types

Functions have type (that’s what the signature is for after all) and functions can be used as values. You can return function from another function or you can pass in a function as a parameter.

Common example is filter, which has following signature: filter :: (a -> Bool) -> [a] -> [a]

It takes two parameters, first one is function that has type a -> Bool and second one is list of a. Return value is list of a. You can produce a list of odd numbers between 1 and 10 with filter odd [1..10].

anonymous functions

Sometimes you need a function to pass in as a parameter, but the function is so small that you don’t want to give it a name. For those cases, anonymous function are good. If you wanted to produce a list of odd numbers that are greater that 5 in range from 1 10, you could write it as: filter (\x -> odd x && x > 5) [1..10]. If you squint hard enough \ looks almost like a lowercase greek letter λ.

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

Writing Web Game in Haskell - Simulation at high level - tuturto | 2019-04-23

So far we have been concentrating on separate pieces of the game. Now it’s time to put some of them together as a simulation.

Overview of simulation

Simulation is done in discrete steps. Each step is roughly 1 earth month (completely arbitrary decision). Shorter than that and there might not be enough happening during turns to keep things interesting. Much longer than that and player might not have enough control on how to react things.

In any case, current time is stored in database in table time. There should be only one row in that table at any given time. And that row has only one value, current time. Time is stored as integer as I didn’t want to deal with problems that you get when adding fractions to a float time after time. So current time (March 2019) would be 2019.3 in game terms and stored as 20193 in database.

Main processing is done in function called processTurn that is shown below. It advances time for one decimal month, removes all expired statuses as explained in episode 2768 and then loads all factions.

After that, various steps of the simulation are carried out for all loaded factions. These include handling special events as explained in episode 2748 and doing observations and report writing in manner described episode 2703.

processTurn :: (BaseBackend backend ~ SqlBackend,
    BackendCompatible SqlBackend backend, PersistUniqueRead backend,
    PersistQueryWrite backend,
    PersistQueryRead backend, PersistStoreWrite backend, MonadIO m) =>
    ReaderT backend m Time
processTurn = do
    newTime <- advanceTime
    _ <- removeExpiredStatuses newTime
    factions <- selectList [] [ Asc FactionId ]
    _ <- mapM (handleFactionEvents newTime) factions
    mapM_ handleFactionFood factions
    mapM_ (handleFactionConstruction newTime) factions
    _ <- mapM (addSpecialEvents newTime) factions
    -- Doing observations should always be done last to ensure players have
    -- recent reports of property they have full control, ie. planets.
    -- Otherwise it's possible that they'll receive reports that are one
    -- turn out of sync.
    mapM_ (handleFactionObservations newTime) factions
    return newTime

More mapping

Remember map and fmap that are used to run a function to each element in a list or general structure? mapM works in a similar way, but is used in monadic context. In processTurn function, we’re dealing with input and output and have IO monad present to allow us to do that (MonadIO m part of the type signature).

If you step back a bit and squint a bit, then map :: (a -> b) -> [a] -> [b] and fmap :: (a -> b) -> f a -> f b and mapM :: Monad m => (a -> m b) -> t a -> m (t b) look pretty similar. Each take a function, structure and produce a new structure which values were created by running the given function for each element of the original structure.

The difference is that map works only for lists, fmap works for functors (that were covered in episode 2778) and mapM works for structures in monadic context.

Best way to contact me nowadays is either by email or through fediverse where I’m tuturto@mastodon.social.

Looping in Haskell - tuturto | 2019-04-10

Haskell is functional language where data is immutable. This means that regular for-loops don’t really exist. Looping however is very common pattern in programs in general. Here are some patterns how to do that in Haskell.

Recursion

Calculating Fibonacci numbers is common example (sort of like hello world in Haskell). There’s many different implementations at https://wiki.haskell.org/The_Fibonacci_sequence if you’re interested on having a look.

Simple recursive definition:

fibs :: Integer -> Integer
fibs 0 = 0
fibs 1 = 1
fibs n = fibs (n-1) + fibs (n-2)

When called with 0 result is 0. When called with 1 result is 1. For all other cases, fibs is called with values n-1 and n-1 and the results are summed together. This works fine when n is small, but calculation gets slow really quickly with bigger values.

Another way is to define list of all Fibonacci numbers recursively:

allFibs :: [Integer]
allFibs = 0 : 1 : zipWith (+) allFibs (tail allFibs)

Here a list is constructed. First element is 0, second element is 1 and rest of the list is obtained by summing the list with its tail (everything but the first element of the list). Definition is recursive and defines all Fibonacci numbers. However, Haskell doesn’t evaluate whole list, but only as much of it as is required.

Common pattern of processing elements in a list, producing a new list:

addOne :: [Integer] -> [Integer]
addOne [] = []
addOne (x:xs) = x + 1 : addOne xs

Two cases, when called with an empty list [], result is empty list. For all other cases, list is taken apart (x:xs), x contains first element of the list and xs is rest of the list. Body of the function creates a new list where head is x + 1 and tail is addOne xs. This processes whole list of Integer by adding one to each value. It also reverses the list.

Second common pattern is processing a list and reducing it to a single value:

sumAll :: Integer -> [Integer] -> Integer
sumAll n [] = n
sumAll n (x:xs) = sumAll (n + x) xs

If given list is empty (the terminal case), result is n. Second case again takes list apart (x:xs), adds x and n together and recursive call sumAll with tail of the list.

This common pattern is discarding some elements of a list:

evenOnly :: [Integer] -> [Integer]
evenOnly [] = []
evenOnly (x:xs) = 
    if even x
        then x : evenOnly xs
        else evenOnly xs

Again, result of empty list is just empty list. In all other cases we first check if x is even. If so, new list is constructed where head is x and tail is evenOnly xs. If x isn’t even, it’s discarded and evenOnly is called recursively with tail of the list.

More tools

Writing recursion by hand gets tedious and sometimes confusing (if you listened to the show, you probably noticed how I got confused and had to check that evenOnly actually works as I thought it would). For that reason, there are tools that abstract these common patterns and given them names.

First is map. It applies given function to each element of a list, thus producing a new list:

> map (+1) [1..10]
[2, 3, 4, 5, 6, 7, 8, 9, 10, 11]
> map odd [1..10]
[True, False, True, False, True, False, True, False, True, False]

Second is fold. There is good article at https://wiki.haskell.org/Foldr_Foldl_Foldl%27 that talks about differences between different folds.

The basic idea behind each fold is the same, they take a function and initial value and then apply them to first element of list, producing a value. This value is then applied with the function to the second element of the list and so on, until whole list has been reduced to a single value. Calculating a sum of list is so common operation that there’s specific function for that: sum.

> foldr (+) 0 [1..10]
55
> foldl (+) 0 [1..10]
55
> sum [1..10]
55

scan is similar to fold, except for returning only the final value, it also returns intermediate ones. Here it’s easier to observe how scanr and scanl differ from each other:

> scanr (+) 0 [1..10]
[55,54,52,49,45,40,34,27,19,10,0]
> scanl (+) 0 [1..10]
[0,1,3,6,10,15,21,28,36,45,55]

Last of the trifecta is filter that is used to select some of the elements in a list based on a supplied function.

> filter odd [1..10]
[1, 3, 5, 7, 9]
> filter even [1..]
[2, 4, 6, 8, 10, 12, 14, 16...]
> take 5 $ filter even [1..] 
[2, 4, 6, 8, 10]

Even more tools

There are even more tools at our disposal. Prelude is basic library of Haskell and browsing online documentation at http://hackage.haskell.org/package/base-4.12.0.0/docs/Prelude.html might yield interesting information.

For example, constructing some lists:

• iterate :: (a -> a) -> a -> [a] For list where function is applied repeatedly.
• repeat :: a -> [a] for a list that contains infinite amount of a.
• replicate :: Int -> a -> [a] For a list that contains finite amount of a.
• cycle :: [a] -> [a] For a infinite list that repeats same list over and over again.

Finding tools

It’s all about knowing the right tools and finding them when needed. Luckily, you don’t have to memorize big stack of notes, but can turn to https://hoogle.haskell.org/ which is Haskell API search engine. It can search based on name or type signature. I often use it to find out if somebody has already written a function that I’m thinking of writing myself.

If you want to send questions or comments, I can be reached with email or at fediverse where I’m tuturto@mastodon.social. This episode is direct result of feedback that I got from previous one. If there’s Haskell topic you would love to hear more, drop me line or even better, research it by yourself and make a cool Hacker Public Radio episode.

Functor and applicative in Haskell - tuturto | 2019-03-27

Two common patterns that I seem to run all the time while working on my 4x space game are functor and applicative. This episode explains them briefly.

Functor

Functor is a way to apply function over a structure we don’t want to alter. Type of the structure stays same, but values inside of it can change. One of the most common one is list, but there are many others.

Functor type class is defined below. There’s one function fmap that takes two parameters: a function from a to b and structure f a. Result will be structure f b.

class Functor f where
    fmap :: (a -> b) -> f a -> f b

This is fairly abstract, so couple example might help. First we define a little helper function that raises it’s argument to 2nd power (in the episode I talk about doubling the value, my mistake there).

-- | this really raises x to 2nd power and doesn't double it
double x = x * x

Given a list of Int we can raise them to power of two by using fmap:

> fmap double [1, 2, 3, 4, 5]
[1, 4, 9, 16, 25]

Since function being applied to structure is type of (a -> b), we can change type of the value inside of the structure. Below is example of turning list of Int to list of Text.

> fmap show [1, 2, 3, 4, 5]
["1", "2", "3", "4", "5"]

This pattern isn’t limited to list and there are many others. You can even define your own ones, if you’re so inclined. The pattern stays the same. One function, fmap, that takes function of type (a -> b) and structure f a and turns it into structure of f b. Details how this is actually done depend on the specific functor.

Other common functor is Maybe that is often used in cases where data might or might not be present. Maybe a has two possible values Just a indicating that value a is present and Nothing indicating that there is no value present. When fmap is used in this context, Just a will turn to Just b and Nothing will stay as Nothing.

> fmap (x -> x * x) $ Just 2
Just 4
> fmap (x -> x * x) Nothing
Nothing

Either a b is sometimes used for value that can be correct or an error. It has two value constructors Right b indicates that value is correct, Left a indicates an error case. a and b don’t have to be of same type (and usually aren’t). For example, if we have Either Text Int, then we have value where error case is Text and correct value is Int.

> fmap double $ Right 5
Right 25
> fmap double $ Left "distance calculation failed because of flux-capacitor malfunction"
Left "distance calculation failed because of flux-capacitor malfunction"

Functors can be placed inside of functors. The only difference is that you have to reach through multiple layers. Simplest way of doing that is to compose multiple fmap functions together like in the example below. Pay attention to in which order nested functors are defined as Maybe [Int] and [Maybe Int] are different things. Former is for case where list of Int might or might not be present. Latter is for case where there’s always list, but single element inside of the list might or might not be present.

> (fmap . fmap) double (Just [1, 2, 3, 4])
Just [1, 4, 9, 16]
> (fmap . fmap) double Nothing :: Maybe Int
Nothing
> (fmap . fmap) double [Just 1, Just 2, Nothing, Just 3]
[Just 1, Just 4, Nothing, Just 9]

There’s also infix operator, that does exactly same thing as fmap, called <$>. The choice which one to use is often either personal or depends on the surrounding code (because Haskell doesn’t use parenthesis in function application, so sometimes it’s easier to use fmap and sometimes <$>).

> fmap show [1, 2, 3, 4, 5]
["1", "2", "3", "4", "5"]

> show <$> [1, 2, 3, 4, 5]
["1", "2", "3", "4", "5"]

There are many more functors, one place to check them is: https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Functor.html

Applicative

While functor works fine when function applied has only one parameter, we need applicative in cases of multiparameter functions. Calling fmap (+) [1, 2] will produce list of functions waiting for second parameter. While it would be possible to handle these cases manually, we like to abstract it to more general solution.

class Functor f => Applicative f where
    pure :: a -> f a
    (<*>) :: f (a -> b) -> f a -> f b

Applicative is similar to functor. The big difference is that function being applied is now embedded inside of same type of structure. While functor has (a -> b), applicative has f (a -> b).

Below is an example of using list applicative to calculate all possible ways of summing two lists of Int.

> (+) <$> [1, 2, 3] <*> [4, 5, 6]
[5,6,7,6,7,8,7,8,9]

Maybe Int works with the same pattern. First we use <$> to get started, this results Maybe containing a function that is waiting for second parameter. Then we use <*> to apply the second parameter so we get the result.

> (+) <$> Just 2 <*> Just 5
Just 7
> (+) <$> Just 2 <*> Nothing
Nothing

As long as there’s only Just a in play, result is Just, but as soon as there’s even single Nothing the end result will be nothing.

If you have questions or comments, I would be delighted to hear about them. You can catch me on fediverse, where I’m tuturto@mastodon.social. Even better, you could record your own HPR episode.

Ad astra!

Writing Web Game in Haskell - Planetary statuses - tuturto | 2019-03-13

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

Haskell - Data types and database actions - tuturto | 2019-02-27

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

Writing Web Game in Haskell - Special events - tuturto | 2019-02-13

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

Writing Web Game in Haskell - News and Notifications - tuturto | 2019-01-23

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

Resources in 4x game - tuturto | 2018-12-26

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)

Fog of war in Yesod based game - tuturto | 2018-12-12

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)

Getting started with web based game in Haskell and Elm - tuturto | 2018-11-28

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)

Yesod - First Impressions - tuturto | 2018-08-15

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

Calculating planetary orbits in Haskell - tuturto | 2018-07-18

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:

• Guide by Paul Schlyter - http://www.stjarnhimlen.se/comp/ppcomp.html
• Sample calculations by Paul Schlyter - http://www.stjarnhimlen.se/comp/tutorial.html
• tuturto's blog post - https://engineersjourney.wordpress.com/2018/06/29/planetary-orbits-and-haskell/
• Definition of orbital elements in Wikipedia - https://en.wikipedia.org/wiki/Orbital_elements
• Units of angle in Wikipedia - https://en.wikipedia.org/wiki/Degree_(angle) and https://en.wikipedia.org/wiki/Radian