HPR2733: Writing Web Game in Haskell - News and Notifications


Manage episode 225690303 series 108988
Discovered by Player FM and our community — copyright is owned by the publisher, not Player FM, and audio streamed directly from their servers.


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

2810 episodes available. A new episode about every day .