Comonadic builders, minor addition

When reading about Comonadic builders the other day I reacted to this comment:

The comonad package has the Traced newtype wrapper around the function (->). The Comonad instance for this newtype gives us the desired behaviour. However, dealing with the newtype wrapping and unwrapping makes our code noisy and truly harder to understand, so let's use the Comonad instance for the arrow (->) itself

So, just for fun I thought I work out the "noisy and truly harder" bits.

To begin with I needed two language extensions and two imports

{-# LANGUAGE OverloadedStrings#-}
{-# LANGUAGE RecordWildCards #-}

import Control.Comonad.Traced
import Data.Text

After that I could copy quite a bit of stuff directly from the other post

• Settings definition
• The Semigroup instance for Settings
• The Monoid instance for Settings
• Project definition

After this everything had only minor changes. First off the ProjectBuilder type had to be changed to

type ProjectBuilder = Traced Settings Project

With that done the types of all the functions can actually be left as they are, but of course the definitions have to modified. However, it turned out that the necessary modifications were rather smaller than I had expected. First out buildProject which I decided to call buildProjectW to make it possible to keep the original code and the new code in the same file without causing name clashes:

buildProjectW :: Text -> ProjectBuilder
buildProjectW = traced . buildProject
  where
    buildProject projectName Settings{..} = Project
      { projectHasLibrary = getAny settingsHasLibrary
      , projectGitHub     = getAny settingsGitHub
      , projectTravis     = getAny settingsTravis
      , ..
      }

The only difference is the addition of traced . to wrap it up in the newtype, the rest is copied straight from the original article.

The two simple project combinator functions, which I call hasLibraryBW and gitHubBW, needed a bit of tweaking. In the original version combinators take a builder which is an ordinary function, so it can just be called. Now however, the function is wrapped in a newtype so a bit of unwrapping is necessary:

hasLibraryBW :: ProjectBuilder -> Project
hasLibraryBW builder = runTraced builder $ mempty { settingsHasLibrary = Any True }

gitHubBW :: ProjectBuilder -> Project
gitHubBW builder = runTraced builder $ mempty { settingsGitHub = Any True }

Once again it's rather small differences from the code in the article.

As for the final combinator, which I call travisBW, actually needed no changes at all. I only rewrote it using a when clause, because I prefer that style over let:

travisBW :: ProjectBuilder -> Project
travisBW builder = project { projectTravis = projectGitHub project }
  where
    project = extract builder

Finally, to show that this implementation hasn't really changed the behaviour

λ extract $ buildProjectW "travis" =>> travisBW
Project { projectName = "travis"
        , projectHasLibrary = False
        , projectGitHub = False
        , projectTravis = False
        }

λ extract $ buildProjectW "github-travis" =>> gitHubBW =>> travisBW
Project { projectName = "github-travis"
        , projectHasLibrary = False
        , projectGitHub = True
        , projectTravis = True
        }

λ extract $ buildProjectW "travis-github" =>> travisBW =>> gitHubBW
Project { projectName = "travis-github"
        , projectHasLibrary = False
        , projectGitHub = True
        , projectTravis = True
        }