> {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE UndecidableInstances #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE LiberalTypeSynonyms #-} > {-# LANGUAGE ImpredicativeTypes #-} > {-# LANGUAGE ConstraintKinds #-} > import Control.Category > import Prelude hiding ( (.), id, Functor(..), Applicative(..), Monad(..) ) > import Data.Params > import Data.Params.Functor > import Data.Params.Applicative > import Data.Params.Monad

At the value level, tying the knot is a classic technique in Haskell data structures. It let’s us build circular datastructures using self-refrence and lazy evaluation. The classic example is the cycle:

> cycle = x where > x = 0 : y > y = 1 : x

But there can be no direct analogy between tying the knot at the value and type level. This is because tying the knot requires lazy evaluation, which doesn’t make sense for types.

*(Idea! Maybe we should just start calling Python a lazily typed language!)*

But let’s check out a new type level technique… and if you look at the right angle… and squint just the right amount… then it sorta kinda looks like tying the knot.

Remember all that fun we had with lensified Functors, Applicatives, and Monads? Our new classes are powerful, but we paid a major price for that power: We gave up parametricity. Parametricity is one of the main properties that makes Haskell code so easy to use and fun to write. Giving it up would be a disaster.

So let’s get it back.

First, we’ll modify our type classes. We’ll need to pass a third parameter to each of them. We’ll call it b. This parameter represents the type at the lens position of our Functor/Applicative/Monad.

> class b ~ GetParam lens tb => Functor' lens tb b where > fmap' :: TypeLens p lens -> (a -> b) -> SetParam lens a tb -> tb > class Functor' lens tb b => Applicative' lens tb b where > pure :: GetParam lens tb -> TypeLens Base lens -> tb > > ap :: ( tf ~ SetParam lens (a -> b) tb > , ta ~ SetParam lens a tb > , a ~ GetParam lens ta > ) > => TypeLens Base lens -> tf -> ta -> tb > class Applicative' lens tfb b => Monad' lens tfb b where > join :: tffb ~ CoJoin lens tfb > => TypeLens Base lens -> tffb -> tfb

Now we can guarantee parametricity when we declare instances of the classes. All we have to do is make sure that the b parameter is a variable and not a type constructor. For example, this is parametric:

instance Functor' (Param_a Base) (Either a b) a

but this is not:

instance Functor' (Param_a Base) (Either Int b) Int

Making our instances parametric is not enough for the type checker. We must prove that all instances will always be parametric. These higher-rank type constraints assert this fact:

> type Functor'' p t = forall a t'. ( t' ~ SetParam p a t, Functor' p t' a ) > type Applicative'' p t = forall a t'. ( t' ~ SetParam p a t, Applicative' p t' a ) > type Monad'' p t = forall a t'. ( t' ~ SetParam p a t, Monad' p t' a )

These type synonym constraints are what I’m calling “tying the type knot.” The foralled a and t’ let us represent an “infinite” number of constraints with a finite size, just like tying the knot lets us represent an infinite data structure with finite memory.

This same technique also works for the constrained monad problem:

> type CnstFunctor p c t = forall a t'. ( t' ~ SetParam p a t, Functor' p t' a, c a ) > type CnstApplicative p c t = forall a t'. ( t' ~ SetParam p a t, Applicative' p t' a, c a ) > type CnstMonad p c t = forall a t'. ( t' ~ SetParam p a t, Monad' p t' a, c a )

So what, exactly, do these new parametric constraints buy us?

Remember how we used the idea of type-level rewrite rules to simplify the type of our applicative sequencing operator (*>)? Now we can simplify it even further.

This is the type that we came up with two posts ago:

(*>) :: ( Applicative lens ( SetParam lens ( a -> b -> b ) tb ) , Applicative lens ( SetParam lens ( b -> b ) tb ) , Applicative lens tb , tb ~ SetParam lens b tb ) => SetParam lens a tb -> tb -> TypeLens Base lens -> tb

It’s pretty clean except for the multiple Applicative constraints. But if we use the type-knotted constraints, we can combine all the Applicatives into one:

(*>) :: ( Applicative'' lens tb , tb ~ SetParam lens b tb ) => SetParam lens a tb -> tb -> TypeLens Base lens -> tb

Unfortunately, we can’t test these parametric constraints today because of a ghc bug/missing feature.

With a heavy dose of sugar, we can use our type lenses to create a type level record syntax. This will make our (*>) operator’s type even clearer… almost like original.

The sugaring rules are pretty simple. Just replace any type expression of the form:

t { lens = a }

with a call to the SetParam type function:

SetParam lens a t

And that’s it!

Now, the lensified and standard versions of (*>) are pretty similar looking. Here they are in a side-by-side comparison:

original (*>) :: Applicative t => t a -> t b -> t b lensified (*>) :: Applicative lens t => t { lens = a } -> t { lens = b } -> t { lens = b }

Sweet!

Next time, we’ll see how to promote everything we’ve done to the kind level.

…

…

…

…

Just kidding!

I’m actually getting married this weekend! I wanted to share my excitement with all you haskellers, so I put together this bad little tying the knot pun! Thanks for putting up with me! Yay!

*(disclaimer: there’s probably lot’s of little mistakes floating around in these posts… type theory isn’t really my area… and I just thought of this idea last week… and… now my brain hurts…)*

We’ll be using all the same extensions as before:

> {-# LANGUAGE TemplateHaskell #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE UndecidableInstances #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE RankNTypes #-}

But we’ll be adding some pretty nasty ones today:

> {-# LANGUAGE OverlappingInstances #-} > {-# LANGUAGE RebindableSyntax #-}

We need RebindableSyntax to get do notation, but OverlappingInstances is just a product of the Monad class’s definition. I’ll give infinite haskell points to anyone who can refactor this code so we don’t need the extension!

We’ll also be needing all of our previous work on Functors and Applicatives. It has been uploaded to hackage and is sitting in the appropriate modules:

> import Control.Category > import Prelude hiding ( (.), id, Functor(..), Applicative(..), Monad(..) ) > import qualified Prelude as P > import GHC.Exts > import Data.Params > import Data.Params.Applicative > import Data.Params.Functor

And we’re off!

We will define our monads in terms of their join function. In the standard libraries, join has the type:

join :: m (m a) -> m a

The input has the same type as the output, except that the Monad m is repeated twice. There are two differences in the lensified join function: First, the monad we’re working with might be nested arbitrarily deeply in other data types. Second, the argument it is monadic in might not be the last one. Here is an example of what the join type signature would look like for the Left Either monad sitting within a Maybe Monad:

join :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Either (Either String Int) Int) -> Maybe (Either String Int)

Since we’re all wannabe category theorists here, we’ll create a CoJoin type family that transforms the output of the join function by duplicating the type at location specified by the lens:

> type family CoJoin (lens :: * -> Constraint) t > type instance CoJoin lens t > = SetParam' > lens > ( SetParam' > ( Objective lens ) > ( GetParam lens t ) > ( GetParam (RemoveObjective lens) t ) > ) > t

*(We covered the Objective and RemoveObjective families in a previous post. As a reminder, the Objective family returns the innermost type lens from our input, and the RemoveObjective family returns the lens that results when the innermost lens is taken away.)*

CoJoin only has one instance, so we could have just used a type synonym. That would make debugging harder, however. The advantage of a type family is that when we ask GHCi what the type is, it will perform the substitutions for us. For example:

ghci> :t undefined :: CoJoin (Param_a Base) (Maybe (Either String Int)) :: Maybe (Maybe (Either String Int)) ghci> :t undefined :: CoJoin (Param_a (Param_a Base)) (Maybe (Either String Int)) :: Maybe (Either (Either String Int) Int)

Now we’re ready to see our new Monad class:

> class Applicative lens tfb => Monad lens tfb where > join :: > ( tffb ~ CoJoin lens tfb > ) => TypeLens Base lens > -> tffb -> tfb

The Left and Right Either instances are:

> instance Monad (Param_a Base) (Either a b) where > join lens (Left (Left a)) = Left a > join lens (Left (Right b)) = Right b > join lens (Right b) = Right b > instance Monad (Param_b Base) (Either a b) where > join lens (Right (Right b)) = Right b > join lens (Right (Left a)) = Left a > join lens (Left a) = Left a

And here are some examples of join in action:

ghci> join _b (Right $ Right "monads") :: Either String String Right "monads" ghci> join _b (Right $ Left "are") :: Either String String Left "are" ghci> join _a (Left $ Left "so") :: Either String String Left "so" ghci> join _a (Right "awesome") :: Either String String Right "awesome"

The instances above don’t consider the case when our lenses point inside of the Either type. We’ll need to define two new recursive instances to handle this case. These instances are the reason we needed the OverlappingInstances language extension:

> instance > ( Monad p a > , Either (CoJoin p a) b ~ CoJoin (Param_a p) (Either a b) -- follows from the lens laws > ) => Monad (Param_a p) (Either a b) > where > > join lens (Left a) = Left $ join (zoom lens) a > join lens (Right b) = Right b > instance > ( Monad p b > , Either a (CoJoin p b) ~ CoJoin (Param_b p) (Either a b) -- follows from the lens laws > ) => Monad (Param_b p) (Either a b) > where > > join lens (Left a) = Left a > join lens (Right b) = Right $ join (zoom lens) b

The equality constraints in the instances above are implied by the lens laws. As we discussed yesterday, with the type rules language extension, those constraints could be removed completely, making the code a bit nicer.

Here are some examples of using join in the nested case:

ghci> join (_a._b) (Left $ Right $ Right "lenses") :: Either (Either a String) b Left (Right "lenses") ghci> join (_a._b) (Left $ Right $ Left "are") :: Either (Either String b) b Left (Left "are") ghci> join (_b._b) (Left "neat") :: Either String (Either a String) Left "neat"

Sometimes we will get the same answer if we join in two separate locations. In the first example below, we join the second two Right constructors, whereas in the second example, we join the first two Right constructors. The results are the same:

ghci> join (_b._b) (Right $ Right $ Right "easy") :: Either a (Either a String) Right (Right "easy") ghci> join _b (Right $ Right $ Right "peasy") :: Either a (Either a String) Right (Right "peasy")

We’ll also be needing a Monad instance for Maybe, so here it is:

> instance Monad (Param_a Base) (Maybe a) where > join lens Nothing = Nothing > join lens (Just Nothing) = Nothing > join lens (Just (Just a)) = Just a > instance > ( Monad p a > , Maybe (CoJoin p a) ~ CoJoin (Param_a p) (Maybe a) -- follows from the lens laws > ) => Monad (Param_a p) (Maybe a) > where > join lens Nothing = Nothing > join lens (Just a) = Just $ join (zoom lens) a

From join and our Applicative instance, we can derive our monadic bind function. We don’t want to use the traditional (>>=) operator for bind just yet. We will need to do something fancy with it to make do notation work out. So instead, we will use the (\\=) operator for bind. Its definition is:

(\\=) :: ( Monad lens tb , a ~ GetParam lens tfa , {- ... lens laws go here ... -} ) => ta -> (a -> tb) -> TypeLens Base lens -> tb > infixl 1 \\= > (m \\= f) lens = join lens $ fmap lens f m

We will create the “minus bind operators” in the same way we created minus operators for the Applicative class. Remember, the minus sign points to the parameters that will get a lens applied to them because they are “minus a lens”. These minus operators are defined as:

> infixl 1 \\=- > infixl 1 -\\=- > infixl 1 -\\= > (m \\=- f) lens = ( m \\= \a -> f a $ objective lens ) lens > (m -\\=- f) lens = ( m lens \\= \a -> f a $ objective lens ) lens > (m -\\= f) lens = ( m lens \\= \a -> f a ) lens

For our example, we’ll build a simple monadic filter. The filterSmall function below sits in the Either Monad, but we’ll be using Left to represent successes (the input passes through the filter), and Right to represent failure (the input doesn’t pass through).

> filterSmall :: (Show a, Ord a) => a -> a -> Either a String > filterSmall k x = if x > k > then Left x > else Right $ show x ++ " is too small"

We can call our function using the monadic bind by:

> chain1 :: Either Int String > chain1 = at _a $ Left 20 \\= filterSmall 10

ghci> chain1 Left 20

Instead of using the Left constructor, we can make things a little more generic by using the return function. As usual, it is equivalent to pure:

> return :: Monad lens t => GetParam lens t -> TypeLens Base lens -> t > return = pure

Sine pure’s last parameter is a type lens, we must use the left-minus (-\\=) variant of bind to sequence the computation:

> chain2 :: Either Int String > chain2 = at _a $ return 20 -\\= filterSmall 10

ghci> chain2 Left 20

Similarly, all the bind operators take a type lens as their last parameter. So any future binds must also use left-minus bind:

> chain3 :: Either Int String > chain3 = at _a $ return 20 -\\= filterSmall 10 -\\= filterSmall 15

ghci> chain3 Left 20

And so on:

> chain4 :: Either Int String > chain4 = at _a $ return 20 -\\= filterSmall 10 -\\= filterSmall 15 -\\= filterSmall 25

ghci> chain4 Right "20 is too small"

We can easily nest our monads. Let’s put all of the computations above inside a Maybe wrapper. All we have to do is change the type signature and the lens:

> chain2' :: Maybe (Either Int String) > chain2' = at (_a._a) $ return 20 -\\= filterSmall 10 > chain3' :: Maybe (Either Int String) > chain3' = at (_a._a) $ return 20 -\\= filterSmall 10 -\\= filterSmall 15 > chain4' :: Maybe (Either Int String) > chain4' = at (_a._a) $ return 20 -\\= filterSmall 10 -\\= filterSmall 15 -\\= filterSmall 25

We’re using the RebindableSyntax language extension to construct a custom do notation. We do this by defining our own (>>=) operator. The most generic bind operator we have is the double minus bind (-\\=-). Sometimes we will want to feed a lens to both sides of the bind, so that’s what we’ll use:

> infixl 1 >>= > (m >>= f) lens = (m -\\=- f) lens

Notice that our (>>=) operator and the one from Prelude take different numbers of arguments! GHC is awesome enough that this is not a problem.

RebindableSyntax also requires us to define functions for failed pattern matching and if statements. Our definitions will be pretty simple:

> fail = error > ifThenElse False _ f = f > ifThenElse True t _ = t

Now, we can take our chain2′ function above and rewrite it in do notation. Here it is again for easy reference:

chain2' :: Maybe (Either Int String) chain2' = at (_a._a) $ return 20 -\\= filterSmall 10

First, rewrite it to use (-\\=-) instead of (-\\=) by causing the right hand side to take a lens parameter even though it won’t use it:

> chain2'' :: Maybe (Either Int String) > chain2'' = at (_a._a) $ return 20 -\\=- (\x lens -> filterSmall 10 x)

Then, rewrite it using do notation:

> chain2''' :: Maybe (Either Int String) > chain2''' = at (_a._a) $ do > x <- return 20 > \lens -> filterSmall 10 x

It looks a little bit nicer if we use const to absorb the lens parameter:

> chain2'''' :: Maybe (Either Int String) > chain2'''' = at (_a._a) $ do > x <- return 20 > const $ filterSmall 10 x

Here is our other examples converted into do notation using the same technique:

> chain3''' :: Maybe (Either Int String) > chain3''' = at (_a._a) $ do > x <- return 20 > y <- const $ filterSmall 10 x > const $ filterSmall 15 y > chain4'' :: Maybe (Either Int String) > chain4'' = at (_a._a) $ do > x <- return 20 > y <- const $ filterSmall 10 x > z <- const $ filterSmall 15 y > const $ filterSmall 25 z

And here is a more complicated expression with a nested do:

> chain5 :: Either a (Either a (Maybe (Either Int String))) > chain5 = at (_b._b._a._a) $ do > x <- return 20 > y <- do > a <- const $ filterSmall x 10 > b <- const $ filterSmall 1 3 > return $ a+b > z <- const $ filterSmall y x > return $ z-x

But there is still a limitation. Due to the way the types work out, the first line of a do block must always be a return statement when using the at function to specify our lens. This is a by product of the extra lens parameter our (>>=) operator is passing around. Fortunately, we can automate this construction with the following function:

> atM lens m = at (removeObjective lens) $ do > return $ at (objective lens) $ m

This lets us rewrite chain5 as:

> chain5' :: Either a (Either a (Maybe (Either Int String))) > chain5' = atM (_b._b._a._a) $ do > let x = 20 > y <- do > a <- const $ filterSmall x 10 > b <- const $ filterSmall 1 3 > return $ a+b > z <- const $ filterSmall y x > return $ z-x

Now we fully support do notation!

Hooray!!

How do we get rid of those ugly const functions?

Can optimus prime use type lenses to save our purity from the effects of the evil decepticons?

Does any one actually care about lensified arrow-do?

Stay tuned to find out.

]]>

We only need these two language extensions for the technique:

> {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE UndecidableInstances #-}

But for our motivating example, we’ll also use these extensions and some basic imports:

> {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE ConstraintKinds #-} > import Data.Proxy > import GHC.Exts

Let’s begin.

Consider the classes:

> class Param_a (p :: * -> Constraint) t > class Param_b (p :: * -> Constraint) t > class Param_c (p :: * -> Constraint) t > class Base t

These classes can be chained together like so:

> type Telescope_abc = Param_a (Param_b (Param_c Base))

It is easy to write a type family that returns the “head” of this list. On a telescope, the lens closest to you is called the eye piece, so that’s what we’ll call our type family:

> type family EyePiece ( p :: * -> Constraint ) :: * -> Constraint > type instance EyePiece (Param_a p) = Param_a Base > type instance EyePiece (Param_b p) = Param_b Base > type instance EyePiece (Param_c p) = Param_c Base

Again, this type family is “open” because new instances can be defined in any file.

We might use this EyePiece type family as:

ghci> :t Proxy :: Proxy (EyePiece Telescope_abc) :: Proxy (Param_a Base)

Now, let’s try to write a type class that does the opposite. Instead of extracting the first element in the chain, it will extract the last. On a telescope the lens farthest away from you is called the objective, so that’s what we’ll call our type family. We’ll also need to define it as a closed type family:

type family Objective (lens :: * -> Constraint) :: * -> Constraint where Objective (Param_a p) = Objective p Objective (Param_b p) = Objective p Objective (Param_c p) = Objective p Objective (Param_a Base) = Param_a Base Objective (Param_b Base) = Param_b Base Objective (Param_c Base) = Param_c Base

We can use the Objective family like:

ghci> :t Proxy :: Proxy (Objective Telescope_abc) :: Proxy (Param_c Base)

The Objective family must be closed. This is because the only way to identify when we are at the end of the telescope is by checking if the p parmaeter is the Base class. If it is, then we’re done. If not, we must keep moving down the telescope recusively. Without a closed type family, we would have to explicitly list all of the recursive paths. This means type instances whenever we want to add a new Param_xxx class. That’s nasty and error prone.

Again, the downside of closed type families is that they must be defined all in one place. We can work around this limitation by “factoring” the closed type family into a collection of closed and open type families. In the example above, this works out to be:

> type family Objective (lens :: * -> Constraint) :: * -> Constraint > type instance Objective (Param_a p) = Objective_Param_a (Param_a p) > type instance Objective (Param_b p) = Objective_Param_b (Param_b p) > type instance Objective (Param_c p) = Objective_Param_c (Param_c p) > type instance Objective Base = Base > type family Objective_Param_a (lens :: * -> Constraint) :: * -> Constraint where > Objective_Param_a (Param_a Base) = Param_a Base > Objective_Param_a (Param_a p) = Objective p > type family Objective_Param_b (lens :: * -> Constraint) :: * -> Constraint where > Objective_Param_b (Param_b Base) = Param_b Base > Objective_Param_b (Param_b p) = Objective p > type family Objective_Param_c (lens :: * -> Constraint) :: * -> Constraint where > Objective_Param_c (Param_c Base) = Param_c Base > Objective_Param_c (Param_c p) = Objective p

ghci> :t Proxy :: Proxy (Objective Telescope_abc) :: Proxy (Param_c Base)

With this factoring, we are able to define the Objective instance for each Param_xxx in separate files and retain the benefits of closed type families.

Here is another example. The RemoveObjective family acts like the init function from the Prelude:

> type family RemoveObjective (lens :: * -> Constraint) :: * -> Constraint > type instance RemoveObjective (Param_a p) = RemoveObjective_Param_a (Param_a p) > type instance RemoveObjective (Param_b p) = RemoveObjective_Param_b (Param_b p) > type instance RemoveObjective (Param_c p) = RemoveObjective_Param_c (Param_c p) > type family RemoveObjective_Param_a (lens :: * -> Constraint) :: * -> Constraint where > RemoveObjective_Param_a (Param_a Base) = Base > RemoveObjective_Param_a (Param_a p) = Param_a (RemoveObjective p) > type family RemoveObjective_Param_b (lens :: * -> Constraint) :: * -> Constraint where > RemoveObjective_Param_b (Param_b Base) = Base > RemoveObjective_Param_b (Param_b p) = Param_b (RemoveObjective p) > type family RemoveObjective_Param_c (lens :: * -> Constraint) :: * -> Constraint where > RemoveObjective_Param_c (Param_c Base) = Base > RemoveObjective_Param_c (Param_c p) = Param_b (RemoveObjective p)

ghci> :t Proxy :: Proxy (RemoveObjective Telescope_abc) :: Proxy (Param_a (Param_b Base))

Of course, you can’t do this trick with every closed type family. For example, the RemoveObjective_Param_c family above cannot be factored any smaller. But if you find yourself wanting the benefits of both closed and open type families, then your type probably has the needed structure.

]]>We’ve seen how to use the typeparams library to soup up our Functor and Applicative type classes. But we’ve been naughty little haskellers—we’ve been using type lenses without discussing their laws! Today we fix this oversight. **Don’t worry if you didn’t read/understand the previous posts.** This post is much simpler and does not require any background.

First, we’ll translate the standard lens laws to the type level. Then we’ll see how these laws can greatly simplify the type signatures of our functions. Finally, I’ll propose a very simple (yes, I promise!) GHC extension that promotes rewrite rules to the type level. These type level rewrite rules would automatically simplify our type signatures for us. It’s pretty freakin awesome.

Today, we won’t actually import anything from the typeparams library. Instead, we’ll be building up everything from scratch.

> {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE PolyKinds #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE ConstraintKinds #-} > {-# LANGUAGE FlexibleContexts #-} > import Control.Category > import Prelude hiding ( (.), id ) > import GHC.Exts

Given a data type:

> data Example a b c = Example a b c

We construct the following empty classes:

> class Param_a (p :: * -> Constraint) t -- has kind :: * -> Constraint > class Param_b (p :: * -> Constraint) t > class Param_c (p :: * -> Constraint) t

These classes are the type level lenses. Each one uniquely identifies a parameter of the Example data type. To use these lenses, we will need to be able to represent them at the value level. So we create the singleton type:

> data TypeLens p q = TypeLens

Now, we can create three values that uinquely identify the three type parameters:

> _a = TypeLens :: TypeLens p (Param_a p) > _b = TypeLens :: TypeLens p (Param_b p) > _c = TypeLens :: TypeLens p (Param_c p)

We’re calling these things lenses, so they must be composable. In fact, they compose really easy. Check out their Category instance:

> instance Category TypeLens where > id = TypeLens > t1.t2 = TypeLens

When we chain values together using the (.) composition operator, we create a chain of classes at the type level. For example:

ghci> :t _a._b _a._b :: TypeLens p (Param_a (Param_b p)) ghci> :t _a._b._c _a._b._c :: TypeLens p (Param_a (Param_b (Param_c p))) ghci> > :t _a._a._b._c._a._b _a._a._b._c._a._b :: TypeLens p (Param_a (Param_a (Param_b (Param_c (Param_a (Param_b p))))))

These chains of classes correspond to a nesting of data types. For the Example type we created above, _a._b would refer to the type param b1 in the type:

Example (Example a1 b1 c1) b2 c2

_a._b._c would refer to b2 in the type:

Example (Example a1 b1 (Example a2 b2 c2)) b0 c0

and _a._a._b._c._a._b would refer to the parameter b6 in the monster type:

Example ( Example ( Example a2 ( Example a3 b3 ( Example ( Example a5 ( Example a6 b6 c6 ) c5 ) b4 c4 ) ) c2 ) b1 c1 ) b0 c0

The whole point of lenses is they give us an easy way to get and set parameters. At the type level, we do that with these type families:

> type family GetParam (p :: * -> Constraint) (t :: *) :: * > type family SetParam (p :: * -> Constraint) (a :: *) (t :: *) :: *

For our Example data type, the implementations look like:

> type instance GetParam (Param_a p) (Example a b c) = GetParam p a > type instance GetParam (Param_b p) (Example a b c) = GetParam p b > type instance GetParam (Param_c p) (Example a b c) = GetParam p c > type instance SetParam (Param_a p) a' (Example a b c) = Example (SetParam p a' a) b c > type instance SetParam (Param_b p) b' (Example a b c) = Example a (SetParam p b' b) c > type instance SetParam (Param_c p) c' (Example a b c) = Example a b (SetParam p c' c)

These definitions are recursive, so we need a base case to halt the recursion:

> class Base t > type instance GetParam Base t = t > type instance SetParam Base t' t = t'

Here are some example usages of the GetParam family:

ghci> :t undefined :: GetParam (Param_a Base) (Example Int b c) :: Int ghci> :t undefined :: GetParam (Param_b Base) (Example Int Float c) :: Float ghci> :t undefined :: GetParam (Param_a (Param_b Base)) (Example (Example a1 Int c1) b2 Float) :: Int ghci> :t undefined :: GetParam (Param_c Base) (Example (Example a1 Int c1) b2 Float) :: Float

And similar uses of the SetParam family:

ghci> :t undefined :: SetParam (Param_a Base) Char (Example Int b Float) :: Example Char b Float ghci> :t undefined :: SetParam (Param_c Base) Char (Example Int b Float) :: Example Int b Char ghci> :t undefined :: SetParam (Param_a (Param_b Base)) Char (Example (Example a1 Int c1) b2 Float) :: Example (Example a1 Char c1) b2 Float ghci> :t undefined :: SetParam (Param_c Base) Char (Example (Example a1 Int c1) b2 Float) :: Example (Example a1 Int c1) b2 Char

The first lens law is that if we set a type parameter to its current value, then the overall type does not change. In code, this looks like:

> type LensLaw1 lens t = t ~ SetParam lens (GetParam lens t) t

The second lens law states that if we set a type parameter to a certain value, then get the value at the location of the lens, then we should get back our original type. In code:

> type LensLaw2 lens a t = a ~ GetParam lens (SetParam lens a t)

And lastly, if we set the same parameter twice, then the last setter wins. In code:

> type LensLaw3 lens a b t = a ~ GetParam lens (SetParam lens a (SetParam lens b t))

There are many other laws that can be derived from these three simple laws. For example, we can derive this fourth lens law from laws 1 and 3:

> type LensLaw4 lens a b t = SetParam lens a (SetParam lens b t) ~ SetParam lens a t

We’re glossing over some technicalities involving injective type families, here, but we’ll return to this later in the post.

Any time we have laws in Haskell, we’ve got to prove that they hold. Sometimes, parametricity does this for us automatically (as in the case of the Functor laws). But usually, we rely on test frameworks like QuickCheck. Therefore, we need these frameworks at the type level.

This turns out to be straightforward. We can use these functions to verify our laws:

> property_lensLaw1 :: LensLaw1 lens t => TypeLens Base lens -> t -> () > property_lensLaw1 _ _ = () > property_lensLaw2 :: LensLaw2 lens a t => TypeLens Base lens -> a -> t -> () > property_lensLaw2 _ _ _ = () > property_lensLaw3 :: LensLaw3 lens a b t => TypeLens Base lens -> a -> b -> t -> () > property_lensLaw3 _ _ _ _ = ()

We test the laws as follows. First, specialize all the type variables in the function. Then, ask GHC if the function type checks. If it does, then the law holds for the type variables we chose.

Here is an example:

ghci> property_lensLaw1 _a (undefined :: Example Int Float String) () ghci> property_lensLaw2 _a (undefined :: String) (undefined :: Example Int Float String) () ghci> property_lensLaw3 _a (undefined :: String) (undefined :: [a]) (undefined :: Example Int Float String) ()

Now, let’s write some GetParam/SetParam instances that do not obey the laws and see what happens. In the NationalSecurityAgency type below, GetParams works just fine, but SetParams is broken.

> data NationalSecurityAgency x = NationalSecurityAgency > class Param_x (p :: * -> Constraint) t > _x = TypeLens :: TypeLens p (Param_x p) > type instance GetParam (Param_x p) (NationalSecurityAgency x) = x > type instance SetParam (Param_x p) x' (NationalSecurityAgency x) = NationalSecurityAgency String

When we test the first lens law using a String, everything works fine:

ghci> lensLaw1 _x (undefined :: NationalSecurityAgency String) ()

But when we test it using an Int, the type checker explodes:

ghci> lensLaw1 _x (undefined :: NationalSecurityAgency Int) :73:1: Couldn't match type ‘[Char]’ with ‘Int’ Expected type: SetParam (Param_x Base) (GetParam (Param_x Base) (NationalSecurityAgency Int)) (NationalSecurityAgency Int) Actual type: NationalSecurityAgency Int In the expression: lensLaw1 _x (undefined :: NationalSecurityAgency Int) In an equation for ‘it’: it = lensLaw1 _x (undefined :: NationalSecurityAgency Int)

You can imagine a template haskell quickcheck that calls these property functions many times on random types to give a probabalistic test our type laws hold.

These laws will greatly simplify inferred types in our programs. We’ll see why using an example.

Consider the beloved Applicative sequencing operator (*>) . In the standard libraries, it has the type:

(*>) :: Applicative f => f a -> f b -> f b

Sweet and simple.

In the applicative class we generated yesterday, however, the sequencing operator is pretty nasty looking. GHCi reports it has the type of:

> (*>) :: > ( Applicative lens > ( SetParam > lens > (a1 -> GetParam lens (SetParam lens (a -> GetParam lens tb1) tb1)) > (SetParam lens (a -> GetParam lens tb1) tb1) > ) > , Applicative lens (SetParam lens (a -> GetParam lens tb1) tb1) > , Applicative lens tb1 > , (b1 -> a2 -> a2) ~ GetParam > lens > (SetParam > lens > (a1 -> GetParam lens (SetParam lens (a -> GetParam lens tb1) tb1)) > (SetParam lens (a -> GetParam lens tb1) tb1)) > , a1 ~ GetParam lens (SetParam lens a1 (SetParam lens (a -> GetParam lens tb1) tb1)) > , tb0 ~ SetParam lens a tb1 > , ta ~ SetParam lens a1 (SetParam lens (a -> GetParam lens tb1) tb1) > , a ~ GetParam lens (SetParam lens a tb1) > ) => ta > -> tb0 > -> TypeLens Base lens > -> tb1 > (*>) = undefined > class Applicative lens t

Yikes! What the hell does that beast do?!

Somehow, we need to simplify this type signature, and the type lens laws are what lets us do this. For example, one of the constraints above is:

a1 ~ GetParam lens (SetParam lens a1 (SetParam lens (a -> GetParam lens tb1) tb1))

We can use the third lens law to simplify this to:

a1 ~ GetParam lens (SetParam lens a1 tb1)

If we repeat this process many times, we get a type signature that looks like:

> newop :: > ( Applicative lens ( SetParam lens ( a -> b -> b ) tb ) > , Applicative lens ( SetParam lens ( b -> b ) tb ) > , Applicative lens tb > , tb ~ SetParam lens b tb > , LensLaw2 lens (b->b) tb > , LensLaw2 lens b tb > , LensLaw3 lens (a -> b -> b) (b -> b) tb > , LensLaw3 lens a (b->b) tb > , LensLaw4 lens (a->b->b) (b->b) tb > , LensLaw4 lens a (b->b) tb > ) => SetParam lens a tb > -> tb > -> TypeLens Base lens > -> tb > newop = (*>)

This looks quite a bit better, but is still less than ideal. Actually, this is as far as you can get with the lens laws in GHC 7.8. You need injective type families to go further. (See this mailing list thread and this ghc trac issue for more details about what injective type families are.) Currently, injectve type families are slated to enter GHC 7.10, so the rest of this post will be a bit more speculative about what this future GHC can do.

Let’s take another look at the type synonyms for the lens laws:

type LensLaw1 lens t = t ~ SetParam lens (GetParam lens t) t type LensLaw2 lens a t = a ~ GetParam lens (SetParam lens a t) type LensLaw3 lens a b t = a ~ GetParam lens (SetParam lens a (SetParam lens b t))

This code only enforces that the laws hold for certain parameters. But that’s not what we want! All types are equal in the eyes of the law, so what we really want is type synonyms that look like:

type LensLaw1' = forall lens t. t ~ SetParam lens (GetParam lens t) t type LensLaw2' = forall lens a t. a ~ GetParam lens (SetParam lens a t) type LensLaw3' = forall lens a b t. a ~ GetParam lens (SetParam lens a (SetParam lens b t))

Unfortunately, sticking this into GHC yields the dreaded “type families may not be injective” error message. With injective type families, we would be able to write these laws. (This is a somewhat bold claim that I won’t justify here.) Then our code would simplify further to:

newop' :: ( Applicative lens ( SetParam lens ( a -> b -> b ) tb ) , Applicative lens ( SetParam lens ( b -> b ) tb ) , Applicative lens tb , tb ~ SetParam lens b tb , LensLaw1' , LensLaw2' , LensLaw3' ) => SetParam lens a tb -> tb -> TypeLens Base lens -> tb newop' = (*>)

We can still do better. The lens laws are not something that applies only to specific functions. They are global properties of the type families, and they apply everywhere. Therefore, they should be implicitly added as constraints into every type signature.

We could make this happen by adding a new syntax called “type rules”. In the same way that value level rewrite rules simplify our values, these type rules would simplify our types. The syntax could look something like:

type rule LensLaw1' = forall lens t. t ~ SetParam lens (GetParam lens t) t type rule LensLaw2' = forall lens a t. a ~ GetParam lens (SetParam lens a t) type rule LensLaw3' = forall lens a b t. a ~ GetParam lens (SetParam lens a (SetParam lens b t))

There are two differences between a type rule and a regular type synonym: First, they can take no type parameters. Second, they are implicitly added to every type signature in your program.

The three rules above would allow us to rewrite our function as:

newop'' :: ( Applicative lens ( SetParam lens ( a -> b -> b ) tb ) , Applicative lens ( SetParam lens ( b -> b ) tb ) , Applicative lens tb , tb ~ SetParam lens b tb ) => SetParam lens a tb -> tb -> TypeLens Base lens -> tb newop'' = (*>)

That is soooo much nicer!

We still have some work to go to get our newop function’s type signature as simple as (*>) from the standard library. But I think we’ve got a realistic shot at it. In a coming post I’ll be proposing a way to combine the multiple Applicative constraints into a single constraint, and a nice looking sugar over the SetParam/GetParam type families.

If you didn’t quite follow the previous posts about Functors and Applicatives, they might make a bit more sense now.

]]>

Okay… down to business.

> {-# LANGUAGE TemplateHaskell #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE UndecidableInstances #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE RankNTypes #-} > {-# LANGUAGE OverloadedStrings #-}

We’ve got a few more imports today. Our work from last time has been uploaded to hackage and is in the Data.Params.Functor module. For parsing, we’ll be torturing the attoparsec library.

> import Control.Category > import Prelude hiding ( (.), id, Functor(..), Applicative(..) ) > import qualified Prelude as P > import Data.Params > import Data.Params.Functor > import qualified Control.Applicative as Ap > import qualified Data.Attoparsec.Text as A > import Data.Attoparsec.Text (parse,Parser,Result) > import Data.Monoid > import Data.Text (Text,pack)

As a quick warm up, let’s talk about the infix fmap operator <$>. The fmap function has type:

fmap :: Functor lens tb => TypeLens Base lens -> (a -> GetParam lens tb) -> SetParam lens a tb -> tb

All this <$> operator does is move fmap’s lens parameter to the end of the parameter list. This restructuring will help us chain our operators together and will be a common theme throughout the post. The operator is defined as:

> infixl 4 <$> > (f <$> t) lens = fmap lens f t

We can use the operator like:

ghci> length <$> (Left $ Right "test") $ _a._b Left (Right 4)

It will also be useful to have an operator just for specifying the type lens. Since a lens specifies the location “at” which we are operating, we call our new operator @@. It is defined as:

> infixr 0 @@ > (@@) :: (TypeLens p q -> b) -> TypeLens p q -> b > (@@) = id

And used like:

ghci> length <$> (Left $ Right "test") @@ _a._b Left (Right 4)

The fourth lens laws states that we must provide both prefix and infix versions of every combinator. Therefore we also introduce the function:

> at :: TypeLens q p -> (TypeLens q p -> t) -> t > at lens f = f lens

ghci> at (_a._b) $ length <$> (Left $ Right "test") Left (Right 4)

We’re ready to see our new Applicative class:

> class Functor lens tb => Applicative lens tb where > > pure :: GetParam lens tb -> TypeLens Base lens -> tb > > ap :: > ( tf ~ SetParam lens (a -> b) tb > , ta ~ SetParam lens a tb > , a ~ GetParam lens ta > , b ~ GetParam lens tb > ) > => TypeLens Base lens > -> tf > -> ta > -> tb

The functions pure and ap have the exact same meaning and laws as their counterparts in the standard libraries. The only difference is the addition of the TypeLens parameter and corresponding constraints.

The Left and Right Applicative instances for the Either class are defined as:

> instance Applicative p a => Applicative (Param_a p) (Either a b) where > pure a lens = Left $ pure a (zoom lens) > ap lens (Right a) _ = Right a > ap lens (Left f) (Right a) = Right a > ap lens (Left f) (Left b) = Left $ ap (zoom lens) f b > instance Applicative p b => Applicative (Param_b p) (Either a b) where > pure b lens = Right $ pure b (zoom lens) > ap lens (Left a) _ = Left a > ap lens (Right f) (Left a) = Left a > ap lens (Right f) (Right b) = Right $ ap (zoom lens) f b

And just like with Functors, we have to define the base case for our recusive definitions:

> instance Applicative Base t where > pure a _ = a > ap _ f = f

Now, to get the Applicative notation we all know and love, we redefine the <*> operator. It is just a thin wrapper around the ap function. Like the <$> operator, we just move the lens parameter to the end:

> infixl 4 <*> > (tf <*> ta) lens = ap lens (tf lens) ta

Easy as cake!

Let’s try it out!

We’ll start with the doubly nested Either. For nested Eithers, the lens we use specifies what the success constructors are. Any other constructors will act as errors.

Here’s an example without an error:

> fact1 :: Either (Either a String) b > fact1 = (++) <$> Left (Right "haskell") <*> Left (Right " rocks!") @@ _a._b

ghci> fact1 Left (Right "haskell rocks!")

Here we have one possible way of signaling an error:

> fact2 :: Either (Either a String) String > fact2 = (++) <$> Left (Right "python") <*> Right "error" @@ _a._b

ghci> fact2 Right "error"

And here we have the other way:

> fact3 :: Either (Either String String) b > fact3 = (++) <$> Left (Right "c++") <*> Left (Left "error") @@ _a._b

ghci> fact3 Left (Left "error")

Of course, Applicatives are much more useful when our functions have many arguments. Let’s create a function that concatenates four strings together into a phrase:

> cat4 :: String -> String -> String -> String -> String > cat4 a b c d = a ++ " " ++ b ++ " "++ c ++ " " ++ d

And create a phrase with no errors:

> phrase1 :: Either (Either a String) b > phrase1 = cat4 > <$> Left (Right "haskell") > <*> Left (Right "is") > <*> Left (Right "super") > <*> Left (Right "awesome") > @@ _a._b

ghci> phrase1 Left (Right "haskell is super awesome")

And a phrase with two errors:

> phrase2 :: Either (Either String String) String > phrase2 = cat4 > <$> Left (Right "python") > <*> Right "error" > <*> Left (Right "is") > <*> Left (Left "error") > @@ _a._b

ghci> phrase2 Right "error"

Notice that in phrase2 we had two different causes of errors. The error with the fewest number of terms will always win. As a proof by example, let’s shuffle around our previous errors. We still get the same result:

> phrase3 :: Either (Either String String) String > phrase3 = cat4 > <$> Left (Right "python") > <*> Left (Left "error") > <*> Left (Right "is") > <*> Right "error" > @@ _a._b

ghci> phrase3 Right "error"

Thisis cool, but it’s not yet very generic. Everytime we want a success, we have to manually specify the constructors we want to use. We can avoid this tedium using the pure function. It’s type signature is:

pure :: Applicative lens tb => GetParam lens tb -> TypeLens Base lens -> tb

The important thing to notice is that the last parameter takes a TypeLens. This follows our magic formula. We can substitute it into our phrase1 variable like:

> phrase1' :: Either (Either a String) b > phrase1' = cat4 > <$> (pure "haskell" @@ _a._b) > <*> (pure "is" @@ _a._b) > <*> (pure "super" @@ _a._b) > <*> (pure "awesome" @@ _a._b) > @@ _a._b

But this is nasty! We have to specify the same TypeLens everywhere we want to use the pure function.

Thankfully, we don’t have to do this. The whole point of lenses is to create ridiculous new combinators that reduce boilerplate! So let’s do that! The “ap minus” combintator will automatically apply the lens for us:

> infixl 4 <*>- > (tf <*>- ta) lens = (tf <*> ta lens) lens

The minus sign signifies that the right side is “minus a lens” and so we should give it one automtically. Using this combinator, we can rewrite our phrase to look like:

> phrase1'' :: Either (Either a String) b > phrase1'' = cat4 > <$> (pure "haskell" @@ _a._b) > <*>- pure "is" > <*>- pure "super" > <*>- pure "awesome" > @@ _a._b

In order to get rid of the first lens application, we’ll need to perform the same trick to <$>:

> infixl 4 <$>- > (f <$>- t) lens = (f <$> t lens) lens

And we get the beautiful:

> phrase1''' :: Either (Either a String) b > phrase1''' = cat4 > <$>- pure "haskell" > <*>- pure "is" > <*>- pure "super" > <*>- pure "awesome" > @@ _a._b

There’s two more Applicative combinators needed for parsing: *> and <* . They use the same definition in the standard libraries, but with a third lens parameter:

> infixl 4 <* > (u <* v) lens = pure const <*> u <*> v @@ lens > infixl 4 *> > (u *> v) lens = pure (const id) <*> u <*> v @@ lens

Now we need to create all of the “minus” operators. Remember that the minus sign points to the variable that will have the lens automatically applied for us:

> infixl 4 <*- > infixl 4 -<*- > infixl 4 -<* > (u <*- v) lens = ( u <* v lens ) lens > (u -<*- v) lens = ( u lens <* v lens ) lens > (u -<* v) lens = ( u lens <* v ) lens > infixl 4 *>- > infixl 4 -*>- > infixl 4 -*> > (u *>- v) lens = ( u *> v lens ) lens > (u -*>- v) lens = ( u lens *> v lens ) lens > (u -*> v) lens = ( u lens *> v ) lens

Confused? Just remember: when you master these new combinators, all the n00bs will worship your l33t h4sk311 5ki115.

Now that we’ve constructed our torture chamber, it’s time to put attoparsec on the rack. We’ll use the built-in “blind” Functor and Applicative instances to define our lensified ones as:

> mkParams ''Parser > instance Functor p a => Functor (Param_a p) (Parser a) where > fmap' lens f parser = P.fmap (fmap' (zoom lens) f) parser > instance Applicative (Param_a Base) (Parser a) where > pure a lens = Ap.pure $ pure a (zoom lens) > ap lens tf ta = tf Ap.<*> ta

And now we’re ready to start parsing. We’ll start simple. The attoparsec library provides a function called string that matches a specified string. We’ll use it to create a Parser that matches the phrase “haskell rocks”:

> chain1 :: TypeLens Base (Param_a Base) -> Parser Text > chain1 = A.string "haskell" *> A.string " rocks"

ghci> parse (chain1 @@ _a) "haskell rocks" Done "" " rocks"

In the above example, we chose to *not* specify the lens in the chain1 variable. This means that if we want to chain it with another parser, we should use the minus then operator like:

> chain2 :: TypeLens Base (Param_a Base) -> Parser Text > chain2 = chain1 -*> A.string "!"

ghci> parse (chain2 @@ _a) "haskell rocks!" Done "" "!"

If we choose to compose on the right, then we’ll need to move the minus sign to the right:

> chain3 :: TypeLens Base (Param_a Base) -> Parser Text > chain3 = A.string "¡" *>- chain2

ghci> parse (chain3 @@ _a) "¡haskell rocks!" Done "" "!"

We have to use minus operators whenever we chain more than two parsers together. In the example below, the first *> takes three parameters (two parsers and a lens). It gets the lens from the minus of the first -*> operator. That operator also needs a lens, which it gets from the next -*>, and so on.

> chain4 :: TypeLens Base (Param_a Base) -> Parser Text > chain4 = A.string "do" > *> A.string " you" > -*> A.string " get" > -*> A.string " it" > -*> A.string " yet?"

ghci> parse (chain4 @@ _a) "do you get it yet?" Done "" " yet?"

If we need to apply a lens to both sides, then we use the -*>- operator:

> chain5 :: TypeLens Base (Param_a Base) -> Parser Text > chain5 = chain3 -*> A.string " ... " -*>- chain4

ghci> parse (chain5 @@ _a) "¡haskell rocks! ... do you get it yet?" Done "" " yet?"

Everything in the last section we could have done without type lenses. But now we’re going to lift the Parser into an arbitrary data type and work with it.

As a concrete example, we’ll put our Parser inside a Maybe. The Maybe Applicative instance is:

> instance Applicative p a => Applicative (Param_a p) (Maybe a) where > pure a lens = Just $ pure a (zoom lens) > ap lens Nothing _ = Nothing > ap lens (Just f) Nothing = Nothing > ap lens (Just f) (Just b) = Just $ ap (zoom lens) f b

And for convenience we’ll use the following parseMaybe function. It has the same effect as the parse function provided by attoparsec, but does everything from within a Maybe.

> parseMaybe :: Maybe (Parser a) -> Text -> Maybe (Result a) > parseMaybe parser str = flip parse str <$> parser @@ _a

Next, we lensify our parser combinators. This string lifts the string function provided by the attoparsec library into an arbitrary parameter specified by our type lens:

> string c lens = pure (A.string c) (zoom lens)

Back to parsing.

Let’s just repeat the same 5 parse chains from above, but now within the Maybe context. Notice two things:

- The A.string function provided by the attoparsec library did not take a type parameter, but our new string function does. This means there’s a lot more minus combinators!
- Instead of specifying our lens to focus on the _a parameter, we must focus on the _a._a parameter to hit the parser.

> chain1' :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain1' = string "haskell" -*>- string " rocks"

ghci> parseMaybe (chain1' @@ _a._a) "haskell rocks" Just Done "" " rocks"

> chain2' :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain2' = chain1' -*>- string "!"

ghci> parse (chain2' @@ _a._a) "haskell rocks!" Done "" '!'

> chain3' :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain3' = string "¡" -*>- chain2'

ghci> parse (chain3' @@ _a._a) "¡haskell rocks!" Done "" '!'

> chain4' :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain4' = string "do" -*>- string " you" -*>- string " get" -*>- string " it" -*>- string " yet?"

ghci> parse (chain4' @@ _a._a) "do you get it yet?" Done "" " yet?"

> chain5' :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain5' = chain3' -*>- string " ... " -*>- chain4'

ghci> parse (chain5' @@ _a._a) "¡haskell rocks! ... do you get it yet?" Done "" " yet?"

Again, there’s nothing special about being nested inside a Maybe. We could be nested inside any monstrous data type of your choosing. Yay!

But in the example we’ve chosen, what happens if we add a Maybe into the chain? Nothing takes over and eats the whole Parser. It doesn’t matter if the Parse was failing or succeeding, the answer is Nothing.

> chain6 :: TypeLens Base (Param_a (Param_a Base)) -> Maybe (Parser Text) > chain6 = string "python" -*> Nothing

ghci> parseMaybe (chain6 @@ _a._a) "python" Nothing ghci> parseMaybe (chain6 @@ _a._a) "haskell" Nothing

Now we’re ready for some super coolness. We’re going to design a parsing circuit that parses three unique Parse streams simultaneously!

Here is our Circuit definition:

> data Circuit x y z > = Circuit (Maybe x) (Maybe y) (Maybe z) > | CircuitFail > deriving (Show) > mkParams ''Circuit

The x, y, and z type params will hold the Parsers. These Parsers are wrapped within a Maybe. A value of Nothing represents that that parser will not consume any input. A value of (Just parser) means that it will consume input.

The Functor instances are rather interesting because of the Maybe wrapper. We must compose _a with the zoomed lens to make the types work out:

> instance Functor p x => Functor (Param_x p) (Circuit x y z) where > fmap' lens f CircuitFail = CircuitFail > fmap' lens f (Circuit x y z) = Circuit (fmap' (_a . zoom lens) f x) y z > instance Functor p y => Functor (Param_y p) (Circuit x y z) where > fmap' lens f CircuitFail = CircuitFail > fmap' lens f (Circuit x y z) = Circuit x (fmap' (_a . zoom lens) f y) z > instance Functor p z => Functor (Param_z p) (Circuit x y z) where > fmap' lens f CircuitFail = CircuitFail > fmap' lens f (Circuit x y z) = Circuit x y (fmap' (_a . zoom lens) f z)

The Applicative instances are where all the action is at. In each case, the pure function is fairly straightforward. It looks just like the other ones we’ve seen except that it applies the _a to the zoomed lens and gives default values of Nothing to the other parsers. The ap function calls ap on the appropriate parser and uses the First Monoid instance on the other two.

> instance > ( Applicative p x > , Monoid y > , Monoid z > ) => Applicative (Param_x p) (Circuit x y z) > where > pure x lens = Circuit (pure x @@ (_a . zoom lens)) Nothing Nothing > ap lens CircuitFail _ = CircuitFail > ap lens _ CircuitFail = CircuitFail > ap lens (Circuit x1 y1 z1) (Circuit x2 y2 z2) = Circuit > (ap (_a . zoom lens) x1 x2) > (getFirst $ First y1 <> First y2) > (getFirst $ First z1 <> First z2) > instance (Monoid x, Applicative p y, Monoid z) => Applicative (Param_y p) (Circuit x y z) where > pure a lens = Circuit Nothing (pure a @@ _a . zoom lens) Nothing > ap lens CircuitFail _ = CircuitFail > ap lens _ CircuitFail = CircuitFail > ap lens (Circuit x1 y1 z1) (Circuit x2 y2 z2) = Circuit > (getFirst $ First x1 <> First x2) > (ap (_a . zoom lens) y1 y2) > (getFirst $ First z1 <> First z2) > instance (Monoid x, Monoid y, Applicative p z) => Applicative (Param_z p) (Circuit x y z) where > pure a lens = Circuit Nothing Nothing (pure a @@ _a . zoom lens) > ap lens CircuitFail _ = CircuitFail > ap lens _ CircuitFail = CircuitFail > ap lens (Circuit x1 y1 z1) (Circuit x2 y2 z2) = Circuit > (getFirst $ First x1 <> First x2) > (getFirst $ First y1 <> First y2) > (ap (_a . zoom lens) z1 z2)

We write a nice wrapper so we can parse our circuits:

> parseCircuit > :: Circuit (Parser x) (Parser y) (Parser z) > -> Text > -> Text > -> Text > -> Circuit (Result x) (Result y) (Result z) > parseCircuit CircuitFail _ _ _ = CircuitFail > parseCircuit (Circuit x y z) str1 str2 str3 = Circuit > ( parseMaybe x str1 ) > ( parseMaybe y str2 ) > ( parseMaybe z str3 )

And now here is a simple circuit for us to play with:

> circ1 :: Circuit (Parser Text) (Parser Text) (Parser Text) > circ1 = Circuit > (string (pack "haskell") @@ _a._a) > (string (pack "is" ) @@ _a._a) > (string (pack "fun" ) @@ _a._a)

When we try to parse our circuit, we just match each word in parallel:

ghci> parseCircuit circ1 "haskell" "is" "fun" Circuit (Just Done "" "haskell") (Just Done "" "is") (Just Done "" "fun")

In this example, we compose our circuit only on the first parameter:

ghci> parseCircuit (circ1 *> circ1 @@ _x._a) "haskell" "is" "fun" Circuit (Just Partial _) (Just Done "" "is") (Just Done "" "fun")

Notice that (above) we no longer finished after matching the word “haskell”. We’ve got a whole ‘nother haskell to go. Oh Joy!

Here, we match completely:

ghci> parseCircuit (circ1 *> circ1 @@ _x._a) "haskellhaskell" "is" "fun" Circuit (Just Done "" "haskell") (Just Done "" "is") (Just Done "" "fun")

In our Circuit type, every parser is—at least so far—acting completely independently. That means one parser can fail while the others succeed:

ghci> parseCircuit circ1 "python " "is" "fun" Circuit (Just Fail "python " [] "Failed reading: takeWith") (Just Done "" "is") (Just Done "" "fun")

Let’s create another simple circuit to play with. In this one, only the first parser performs any actions. The other two are noops:

> circ2 :: Circuit (Parser Text) (Parser y) (Parser z) > circ2 = Circuit > (string (pack " with lenses") @@ _a._a) > Nothing > Nothing

We can compose circ1 and circ2 exactly as you would suspect. Our original string is now only a partial match:

ghci> parseCircuit (circ1 *> circ2 @@ _x._a) "haskell" "is" "fun" Circuit (Just Partial _) (Just Done "" "is") (Just Done "" "fun")

But this matches perfectly:

ghci> parseCircuit (circ1 *> circ2 @@ _x._a) "haskell with lenses" "is" "fun" Circuit (Just Done "" " with lenses") (Just Done "" "is") (Just Done "" "fun")

And this fails:

ghci> parseCircuit (circ1 *> circ2 @@ _x._a) "haskell without lenses" "is" "fun" Circuit (Just Fail " without lenses" [] "Failed reading: takeWith") (Just Done "" "is") (Just Done "" "fun")

We can simplify the code of circ2 even further (and make it more generic) using the pure function:

> circ3 :: Circuit (Parser Text) (Parser y) (Parser z) > circ3 = pure (string (pack " with lenses") @@ _a) @@ _x

circ3 behaves exactly like circ2 when sequenced with circ1:

ghci> parseCircuit (circ1 *> circ3 @@ _x._a) "haskell with lenses" "is" "fun" Circuit (Just Done "" " with lenses") (Just Done "" "is") (Just Done "" "fun")

And that’s enough for today. GHC needs to rest. It’s tired.

We’ve still go so many tantalizing questions to answer:

- What is that CircuitFail gizmo doing?
- How do I use Alternative to branch my parser?
- Can a Circuit’s parser depend on the other parsers in the Circuit?
- Do fiber optic burritos taste good??!?!

Stay tuned to find out!

]]>

First, enable some GHC magic:

> {-# LANGUAGE TemplateHaskell #-} > {-# LANGUAGE ScopedTypeVariables #-} > {-# LANGUAGE KindSignatures #-} > {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE UndecidableInstances #-} > {-# LANGUAGE FlexibleInstances #-} > {-# LANGUAGE RankNTypes #-}

And import our libraries:

> import Control.Category > import Prelude hiding ( (.), id, Functor(..) ) > import Data.Params

We’ll use the Either type as our main example. It’s defined as:

data Either a b = Left a | Right b

The Functor instance is pretty straightforward:

class Functor f where fmap :: (a -> b) -> f a -> f b instance Functor (Either a) where fmap f (Left a) = Left a fmap f (Right b) = Right $ f b

But this instance has a key limitation: We can map a function only over the the last type.

Bifunctors are the current solution to this problem. A recent, popular proposal suggested adding them to base. But this is an ad hoc solution whose application does not extend far beyond the Either type.

Type lenses will (kinda sort of) provide a cleaner solution. That is, they fix the problem about as well as regular old lenses fix the problems of record selectors. As a bonus, we’ll get a convenient mechanism for mapping over nested Functors.

Here is the alternative definition of the Functor class using type lenses:

> class Functor lens t where > fmap' :: a ~ GetParam lens t > => TypeLens p lens > -> (a -> b) > -> t > -> SetParam lens b t

It’s okay if you don’t understand the type signature at first glace. (That’s how know you’re using lenses, afterall!) Let’s step through it using the Either example.

The first argument is the type lens. This indicates which parameter we will be mapping over the type t. In the Either data type, we could use the variable _a to map over the Left component or _b to map over the Right.

Next, we encounter two type families, GetParam and SetParam. These act as getters and setters at the type level. In the above example, GetParam is used to extract arbitrary type params from a type. It is defined as:

type family GetParam (p::k1) (t:: *) :: k3 type instance GetParam Param_a (Either a b) = a type instance GetParam Param_b (Either a b) = b

The SetParam type similarly sets the type of arbitrary params in a type. It is defined as:

type family SetParam (p::k1) (a::k2) (t:: *) :: * type instance SetParam Param_a a' (Either a b) = Either a' b type instance SetParam Param_b b' (Either a b) = Either a b'

These instances can be automatically provided for any type by calling the mkParams template haskell function like so:

> mkParams ''Either

Quick aside: With injective type families and a little sugar, we could make this definition of Functor a tad cleaner.

We can replicate the traditional Functor instance with the code:

instance Functor (Param_b Base) (Either a b) where fmap' lens f (Left a) = Left a fmap' lens f (Right b) = Right $ f b

and create a “Left” Functor instance as:

instance Functor (Param_a Base) (Either a b) where fmap' lens f (Left a) = Left $ f a fmap' lens f (Right b) = Right b

Together, these instances let us run the commands:

ghci> fmap _b length $ Left "Roses are red," Left "Roses are red," ghci> fmap _b length $ Rightt "Violets are blue," Right 17 ghci> fmap _a length $ Left "Haskell is fun," Left 15 ghci> fmap _a length $ Right "Type lenses are cool." Right "Type lenses are cool."

With the above definitions, we can’t combine our type lenses at all. Enter the funnily named and awkwardly typed zoom combinator:

zoom :: TypeLens a p -> TypeLens a (Zoom p)

This combinator lets us zoom into a composed type lens, removing the outer most layer. For example, given the composed type lens:

ghci> :t _a._b._a._b _a._b._a._b :: TypeLens a (Param_a (Param_b (Param_a (Param_b a))))

Then zooming in removes the first _a:

ghci> :t zoom (_a._b._a._b) zoom (_a._b._a._b) :: TypeLens a (Param_b (Param_a (Param_b a)))

We will use this combinator to redefine our Functor instances. The new instances will recursively map over every Functor in our input lens:

> instance Functor p b => Functor (Param_b p) (Either a b) where > fmap' lens f (Left a) = Left a > fmap' lens f (Right b) = Right $ fmap' (zoom lens) f b > > instance Functor p a => Functor (Param_a p) (Either a b) where > fmap' lens f (Left a) = Left $ fmap' (zoom lens) f a > fmap' lens f (Right b) = Right b

The type Base provides the base case of the recursion:

> instance Functor Base t where > fmap' _ f a = f a

Now, in order to call fmap’, we must compose our lens with the type lens:

_base :: TypeLens Base Base

For example:

ghci> :t _a._b._a._b._base deeplens :: TypeLens Base (Param_a (Param_b (Param_a (Param_b Base))))

And we call fmap’ like:

ghci> fmap' (_a._b._a._b._base) length $ Left $ Right $ Left $ Right "still simpler than the lens package " Left (Right (Left (Right 42))) ghci> fmap' (_a._b._a._b._base) length $ Left $ Right $ Left $ Left "... for now ..." Left (Right (Left (Left "... for now ...")))

Composing all of our lenses with _base is tedious. So let’s write a function that automates that task:

> fmap :: > ( Functor lens t > ) => TypeLens Base lens > -> (GetParam lens t -> c) > -> t > -> SetParam lens c t > fmap lens = fmap' (lens._base)

And we call fmap as:

ghci> fmap (_a._b._a._b) length $ Left $ Right $ Left $ Left "mwahhahahaha" Left (Right (Left (Left "mwahhahahaha")))

We can easily define more of these new Functor instances. In fact, the procedure is exactly as mechanical for type lens based Functors as it is for the traditional Functors. All you have to do is replace every function application with a recursive Functor call:

f x --> fmap' (zoom lens) f x

Here are some examples using the list and Maybe functors:

> mkParams ''[] > instance Functor p a => Functor (Param_a p) [a] where > fmap' lens f [] = [] > fmap' lens f (a:as) = fmap' (zoom lens) f a : fmap' lens f as

> mkParams ''Maybe > instance Functor p a => Functor (Param_a p) (Maybe a) where > fmap' lens f Nothing = Nothing > fmap' lens f (Just a) = Just $ fmap' (zoom lens) f a

Let’s create a variable that uses all of our functors:

> monster = > [ Nothing > , Just (Left "Hello!") > , Just (Right 42) > , Just (Left "World!") > ]

And go to town:

ghci> fmap (_a._a._a._a) succ monster [Nothing,Just (Left "Ifmmp\""),Just (Right 42),Just (Left "Xpsme\"")] ghci> fmap (_a._a._a) length monster [Nothing,Just (Left 6),Just (Right 42),Just (Left 6)] ghci> fmap (_a._a) (const 3.4) monster [Nothing,Just 3.4,Just 3.4,Just 3.4] ghci> fmap _a show monster ["Nothing","Just (Left \"Hello!\")","Just (Right 42)","Just (Left \"World!\")"]

In our next installment, we’ll tackle Applicative parsing with type lenses. Thought the lens package had too many operators??? You ‘aint seen ‘nothin yet.

]]>I joined the Navy because I wanted to serve my country. My religious beliefs no longer allow me to kill, but I still want to serve. Service, in fact, is an integral part of my beliefs. My country has given me a lot. I value the ideas of freedom and democracy. I want to give everything I have to my country and the ideals for which it stands. Ideally, I would serve in a capacity that maximizes the peace and welfare of the United States, but minimizes my contribution to war. I believe these goals are not mutually exclusive. This document explores how well my service options meet these goals, both inside and outside the military. This will explain my decision not to apply for noncombatant (1-A-0) status.

All billets in the military are designed to maximize the security of the United States, and these billets contribute to war in varying degrees. If a billet existed which did not contribute to war in any way, I would gladly volunteer for it. No matter how dangerous, difficult, time-consuming, or otherwise undesirable the job may be, I would enthusiastically perform this job to the best of my abilities. I cannot know every billet available, but I do know what communities exist. The Navy’s officer community is divided into four main groups: unrestricted line officers, restricted line officers, special duty officers, and the staff corps. I will classify these communities depending on whether they present high, medium, or low conflict with my beliefs.

I will demonstrate that had I applied for noncombatant (1-A-0) status, I would still be placed in a billet which conflicts with my beliefs. According to regulation MILPERSMAN 1900-020, a noncombatant can be assigned to serve “on board an armed ship or aircraft in a combat zone provided the member is not personally and directly involved in the operation of weapons.” For example, as a nuclear trained officer, I could be assigned to operate the nuclear propulsion system for an aircraft carrier. I would not be the individual delivering bombs to their targets, so according to regulations I would not be responsible. But according to my conscience I would still be responsible.

**High conflict communities**

Most of the Navy’s communities are primarily warfare related. These communities provide the maximum conflict with my convictions. The unrestricted line officers form the heart of the Navy. Their duties involve training for war, and conducting war once begun. This directly goes against my nonviolent religious beliefs. These communities include:

- Surface warfare
- Submarine warfare
- Naval aviation
- Naval flight officers
- Special warfare

Notably, by the definition of a 1-A-0 noncombatant I could still be billeted within these high conflict communities.

**Medium conflict communities**

Even if I were guaranteed a billet not in the high conflict communities, all naval communities present at least a medium conflict with my beliefs. They all participate in war indirectly because their missions are to make the warfighters more effective. The navy divides these medium conflict communities into three categories: restricted line officers, special duty officers, and staff corps.

Restricted line officers prepare the Navy for warfare. Without their support, the fighting elements of the Navy could not complete their missions. Therefore, these communities still provide significant conflict with my nonviolent religious beliefs. These communities include:

- Human Resources Officers “plan, program and execute life-cycle management of our Navy’s most important resource – people.”
- Nuclear Propulsion Training officers teach students the fundamentals of nuclear propulsion. The purpose of this training is so that students qualify in ship driving, and the training is critical in their training for war.
- Naval Reactors Engineers ensure the safe and reliable operation of the Navy’s nuclear propulsion plants. This ensures the combat readiness of the Navy’s submarine force and aircraft carriers.
- Engineering Duty Officers design, construct, and maintain the Navy’s ships. These ships are designed around their capabilities to project power and deliver weapons systems to enemy targets.
- Aerospace Engineering Duty officers perform a similar role for the Navy’s airplanes.
- Foreign Area Officers “manage and analyze politico-military activities overseas.”

Special duties officers are similar to unrestricted line officers in that they are usually only indirectly involved in warfare. This includes:

- Intelligence officers provide “tactical, operational and strategic intelligence support to U.S. naval forces, joint services, multi-national forces, and executive level decision-makers.”
- Public Affairs are responsible for projecting a good moral image of the Navy’s warfighting
- Recruiters convince young men and women to join the warfighting elements of the navy
- Fleet Support officers provide engineering assistance to warfighting units
- Meteorology/Oceanography officers “collect, analyze, and distribute data about the ocean and the atmosphere to Navy forces operating all over the world. They assist the war fighter in taking tactical advantage of the environment.”

Special duties officers are similar to unrestricted line officers. They includes:

- Information Professionals maintain the electronic equipment aboard naval installations
- Information Warfare officers “deliver overwhelming information superiority that successfully supports command objectives… And ultimately, providing war-fighters, planners and policy makers with real-time warning, offensive opportunities and an ongoing operational advantage.”
- Cyber Warfare Engineers conduct electronic attacks

Staff corps officers are like special duties officers that require special training. They include doctors and JAGs. I would not be qualified for any of these billets.

I believe there are many opportunities outside the military that would allow me to serve in a manner consistent with my beliefs. Should I be given a discharge, I will pursue such service. I would gladly accept as a condition of my discharge some other type of obligated service. Many conscientious objectors in the past have served honorably in government service. They have volunteered to restore national parks, serve in psychiatric wards, and even have medical experiments conducted on themselves. The smoke jumpers—an elite group of firefighters who parachute into blazing fires—were founded by conscientious objectors.

I have received training that can be utilized nonviolently in two areas: computer science and nuclear power. This training can be used nonviolently to promote the effective defense of the United States.

In a defensive capacity, my computer science training could be used to safeguard electronic systems against attack. Criminal organizations routinely target government electronic infrastructure. Sometime they are looking for specific information, sometimes simply to cause disruptions. I have significant experience protecting electronic assets. I would proudly serve in a role where I would harden the United States government and infrastructure against such threats.

In a defensive capacity, my nuclear training could be used to reduce the threat of nuclear weapons. The current administration has expressed an intent to reduce the nation’s nuclear arsenal. I could apply my nuclear training with the Department of Energy

All available billets within the Navy present high conflict with my belief in Jesus. I therefore cannot apply for noncombatant 1-A-0 status. But there are many other roles within the federal government that I am both highly qualified for and present no such conflict. I would gladly serve in such a capacity, no matter how difficult or dangerous the job may be.

]]>Here’s a picture:

The blue dot in the center of the parallelogram is **me** (or **you**!). Each of the dots on the corners represent different archetypes that we can follow.

In the bottom left is **Jonah**. Jonah was nonviolent, but he wasn’t a very good person. When God commanded Jonah to go help Ninevah, Jonah ran away. He was too concerned about his own personal comfort and safety to think about others. When we act like Jonah, the world suffers. As the saying goes, “all it takes for evil to triumph is for good men to do nothing.”

But we can get quite a bit more evil. If we perform violent actions, we travel right in the diagram. This takes us to **Judas**. Judas came with armed men to capture and kill the innocent Jesus. By using violence in this way, we can bring about quite a bit more evil than by doing nothing. That is why Judas is farther down in the diagram than Jonah. The farther down you are, the more evil you are.

But not all violence is created equal. If we travel up from Judas, we get to **David**. David was a king of Israel and is considered one of the most righteous people of the old testament. He used violence to protect the innocent. When a soldier kills a suicide bomber before the bomber can kill innocent civilians, the soldier is imitating David. The soldier has risked his own safety and done a *good* thing.

But it was not the *best* thing. If we travel again to the left in the diagram we come to **Jesus**. Jesus did not use violence, and he embodied all that is good in the world. When the devil gave Jesus the opportunity to use violence to stop evil people (Matthew 4:1-11), Jesus chose a better path: He sacrificed himself for those evil people. He died on the cross. While violence may be useful in protecting the innocent, it is useless when saving the guilty from themselves. This is a much harder (and in the Christian perspective much more righteous) task. That is why Jesus is higher in the diagram than David.

My goal is to be as much like Jesus as possible. Here’s two examples of how we can use the parallelogram to do this:

**Example 1:** Let’s rethink the story of David and Goliath as told by 1 Samuel 17. The Philistines are invading Israel, and are camped inside the borders of Judah. Every day, the giant Goliath comes forward and challenges the Israelites to single combat. At this point, the Jonah option would be to hide in the ranks. Jonah would depend on someone else to save the Israelites. The Judas option would be to secretly meet with the invading army. Judas would help the Philistines kill the Jews in the hope of escaping a similar fate. Enter David. David was brave. He chose to fight the Goliath single handedly. He wanted to save his friends from doom, and this was a *good* thing.

But it was not the *best* thing. What would Jesus have done? I can’t know for sure, but I can speculate: I think Jesus would have helped the Philistines. He would have delivered them water and food. He would have healed their wounded and cared for the widows and orphans left behind. Jesus would have been willing to die not just for the Israelites (like David), but also for the Philistines. What greater love is there than *that*!?

**Example 2**: The parallelogram has informed my personal development as a Christian. **(1)** Like most adolescents, I had no desire to risk my own safety for others. I didn’t stand up for the weird kids when the bullies picked on them. I followed Jonah. **(2)** This changed after September 11th. Around that time, I started taking my Christian faith seriously. The world trade centers taught me that there is evil in the world, and Christ showed me that this was not how the world was meant to be. I decided to do my best to fix the world, so I joined the Navy. David became my role model. **(3)** But David couldn’t heal my broken soul. I thought I could be the world’s savior, but only Jesus can do that. So I recommitted myself to Christ and decided to take his teaching to “turn the other cheek” seriously. (There’s a lot more to this transformation, and you can read about it here.)

In graphical form:

Notice that I don’t consider myself more righteous than David. In fact, I firmly believe that there have been violent people more righteous than I am! Nonetheless, my calling is to be like Jesus. That means striving for something better than David. My new goal is to follow the dotted line**…** to change the world by offering myself as a living sacrifice.

I fail every day. But with Christ’s grace, I find renewed strength to keep trying. That is why I call myself a Christian pacifist.

]]>This post focuses on how to use functors and monads in practice with the HLearn library. We won’t talk about their category theoretic foundations; instead, we’ll go through **ten concrete examples** involving the categorical distribution. This distribution is somewhat awkwardly named for our purposes because it has nothing to do with category theory—it is the most general distribution over non-numeric (i.e. categorical) data. It’s simplicity should make the examples a little easier to follow. Some more complicated models (e.g. the kernel density estimator and Bayesian classifier) also have functor and monad instances, but we’ll save those for another post.

Before we dive into using functors and monads, we need to set up our code and create some data. Let’s install the packages:

$ cabal install HLearn-distributions-1.1.0.1

Import our modules:

> import Control.ConstraintKinds.Functor > import Control.ConstraintKinds.Monad > import Prelude hiding (Functor(..), Monad (..)) > > import HLearn.Algebra > import HLearn.Models.Distributions

For efficiency reasons we’ll be using the Functor and Monad instances provided by the ConstraintKinds package and language extension. From the user’s perspective, everything works the same as normal monads.

Now let’s create a simple marble data type, and a small bag of marbles for our data set.

> data Marble = Red | Pink | Green | Blue | White > deriving (Read,Show,Eq,Ord) > > bagOfMarbles = [ Pink,Green,Red,Blue,Green,Red,Green,Pink,Blue,White ]

This is a very small data set just to make things easy to visualize. Everything we’ll talk about works just as well on arbitrarily large data sets.

We train a categorical distribution on this data set using the **train** function:

> marblesDist = train bagOfMarbles :: Categorical Double Marble

The **Categorical** type takes two parameters. The first is the type of our probabilities, and the second is the type of our data points. If you stick your hand into the bag and draw a random marble, this distribution tells you the probability of drawing each color.

Let’s plot our distribution:

ghci> plotDistribution (plotFile "marblesDist" $ PNG 400 300) marblesDist

Okay. Now we’re ready for the juicy bits. We’ll start by talking about the list functor. This will motivate the advantages of the categorical distribution functor.

A functor is a container that lets us “map” a function onto every element of the container. Lists are a functor, and so we can apply a function to our data set using the **map** function.

map :: (a -> b) -> [a] -> [b]

**Example 1:**

Let’s say instead of a distribution over the marbles’ colors, I want a distribution over the marbles’ weights. I might have a function that associates a weight with each type of marble:

> marbleWeight :: Marble -> Int -- weight in grams > marbleWeight Red = 3 > marbleWeight Pink = 2 > marbleWeight Green = 3 > marbleWeight Blue = 6 > marbleWeight White = 2

I can generate my new distribution by first transforming my data set, and then training on the result. Notice that the type of our distribution has changed. It is no longer a categorical distribution over marbles; it’s a distribution over ints.

> weightsDist = train $ map marbleWeight bagOfMarbles :: Categorical Double Int

ghci> plotDistribution (plotFile "weightsDist" $ PNG 400 300) weightsDist

This is the standard way of preprocessing data. But we can do better because the categorical distribution is also a functor. Functors have a function called **fmap** that is analogous to calling map on a list. This is its type signature specialized for the Categorical type:

fmap :: (Ord dp0, Ord dp1) => (dp0 -> dp1) -> Categorical prob dp0 -> Categorical prob dp1

We can use fmap to apply the marbleWeights function directly to the distribution:

> weightDist' = fmap marbleWeight marblesDist

This is guaranteed to generate the same exact answer, but it is much faster. **It takes only constant time to call Categorical’s fmap, no matter how much data we have!**

Let me put that another way. Below is a diagram showing the two possible ways to generate a model on a preprocessed data set. Every arrow represents a function application.

The normal way to preprocess data is to take the bottom left path. But because our model is a functor, the top right path becomes available. This path is better because it has the shorter run time.

Furthermore, let’s say we want to experiment with different preprocessing functions. The standard method will take time, whereas using the categorical functor takes time .

*Note: The diagram treats the number of different categories (m) as a constant because it doesn’t depend on the number of data points. In our case, we have 5 types of marbles, so m=5. Every function call in the diagram is really multiplied by m.*

**Example 2:**

For another example, what if we don’t want to differentiate between red and pink marbles? The following function converts all the pink marbles to red.

> pink2red :: Marble -> Marble > pink2red Pink = Red > pink2red dp = dp

Let’s apply it to our distribution, and plot the results:

> nopinkDist = fmap pink2red marblesDist

ghci> plotDistribution (plotFile "nopinkDist" $ PNG 400 300) nopinkDist

That’s about all that a Functor can do by itself. When we call fmap, we can only process individual data points. We can’t change the number of points in the resulting distribution or do other complex processing. Monads give us this power.

Monads are functors with two more functions. The first is called **return**. Its type signature is

return :: (Ord dp) => dp -> Categorical prob dp

We’ve actually seen this function already in previous posts. It’s equivalent to the **train1dp** function found in the **HomTrainer** type class. All it does is train a categorical distribution on a single data point.

The next function is called **join.** It’s a little bit trickier, and it’s where all the magic lies. Its type signature is:

join :: (Ord dp) => Categorical prob (Categorical prob dp) -> Categorical prob dp

As input, join takes a categorical distribution whose data points are other categorical distributions. It then “flattens” the distribution into one that does not take other distributions as input.

**Example 3**

Let’s write a function that removes all the pink marbles from our data set. Whenever we encounter a pink marble, we’ll replace it with an empty categorical distribution; if the marble is not pink, we’ll create a singleton distribution from it.

> forgetPink :: (Num prob) => Marble -> Categorical prob Marble > forgetPink Pink = mempty > forgetPink dp = train1dp dp > > nopinkDist2 = join $ fmap forgetPink marblesDist

ghci> plotDistribution (plotFile "nopinkDist2" $ PNG 400 300) nopinkDist2

This idiom of **join ( fmap … )** is used a lot. For convenience, the** >>=** operator (called **bind**) combines these steps for us. It is defined as:

(>>=) :: Categorical prob dp0 -> (dp0 -> Categorical prob dp1) -> Categorical prob dp1 dist >>= f = join $ fmap f dist

Under this notation, our new distribution can be defined as:

> nopinkDist2' = marblesDist >>= forgetPink

**Example 4
**

Besides removing data points, we can also add new ones. Let’s double the number of pink marbles in our training data:

> doublePink :: (Num prob) => Marble -> Categorical prob Marble > doublePink Pink = 2 .* train1dp Pink > doublePink dp = train1dp dp > > doublepinkDist = marblesDist >>= doublePink

ghci> plotDistribution (plotFile "doublepinkDist" $ PNG 400 300) doublepinkDist

**Example 5
**

Mistakes are often made when collecting data. One common machine learning task is to preprocess data sets to account for these mistakes. In this example, we’ll assume that our sampling process suffers from uniform noise. Specifically, if one of our data points is red, we will assume there is only a 60% chance that the marble was actually red, and a 10% chance each that it was one of the other colors. We will define a function to add this noise to our data set, increasing the accuracy of our final distribution.

Notice that we are using fractional weights for our noise, and that the weights are carefully adjusted so that the total number of marbles in the distribution still sums to one. We don’t want to add or remove marbles while adding noise.

> addNoise :: (Fractional prob) => Marble -> Categorical prob Marble > addNoise dp = 0.5 .* train1dp dp <> 0.1 .* train [ Red,Pink,Green,Blue,White ] > > noiseDist = marblesDist >>= addNoise

ghci> plotDistribution (plotFile "noiseDist" $ PNG 400 300) noiseDist

Adding uniform noise just made all our probabilities closer together.

**Example 6
**

Of course, the amount of noise we add to each sample doesn’t have to be the same everywhere. If I suffer from red-green color blindness, then I might use this as my noise function:

> rgNoise :: (Fractional prob) => Marble -> Categorical prob Marble > rgNoise Red = trainW [(0.7,Red),(0.3,Green)] > rgNoise Green = trainW [(0.1,Red),(0.9,Green)] > rgNoise dp = train1dp dp > > rgNoiseDist = marblesDist >>= rgNoise

ghci> plotDistribution (plotFile "rgNoiseDist" $ PNG 400 300) rgNoiseDist

Because of my color blindness, the probability of drawing a red marble from the bag is higher than drawing a green marble. This is despite the fact that we observed more green marbles in our training data.

**Example 7
**

In the real world, we can never know exactly how much error we have in the samples. Luckily, we can try to learn it by conducting a second experiment. We’ll first experimentally determine how red-green color blind I am, then we’ll use that to update our already trained distribution.

To determine the true error rate, we need some unbiased source of truth. In this case, we can just use someone with good vision. They will select ten red marbles and ten green marbles, and I will guess what color they are.

Let’s train a distribution on what I think green marbles look like:

> greenMarbles = [Green,Red,Green,Red,Green,Red,Red,Green,Green,Green] > greenDist = train greenMarbles :: Categorical Double Marble

and what I think red marbles look like:

> redMarbles = [Red,Green,Red,Green,Red,Red,Green,Green,Red,Red] > redDist = train redMarbles :: Categorical Double Marble

Now we’ll create the noise function based off of our empirical data. The **(/.)** function is scalar division, and we can use it because the categorical distribution is a vector space. We’re dividing by the number of data points in the distribution so that the distribution we output has an effective training size of one. This ensures that we’re not accidentally creating new data points when applying our function to another distribution.

> rgNoise2 :: Marble -> Categorical Double Marble > rgNoise2 Green = greenDist /. numdp greenDist > rgNoise2 Red = redDist /. numdp redDist > rgNoise2 dp = train1dp dp > > rgNoiseDist2 = marblesDist >>= rgNoise2

ghci> plotDistribution (plotFile "rgNoiseDist2" $ PNG 400 300) rgNoiseDist2

**Example 8
**

We can chain our preprocessing functions together in arbitrary ways.

> allDist = marblesDist >>= forgetPink >>= addNoise >>= rgNoise

ghci> plotDistribution (plotFile "allDist" $ PNG 400 300) allDist

But wait! Where’d that pink come from? Wasn’t the call to forgetPink supposed to remove it? The answer is that we did remove it, but then we added it back in with our noise functions. When using monadic functions, we must be careful about the order we apply them in. This is just as true when using regular functions.

Here’s another distribution created from those same functions in a different order:

> allDist2 = marblesDist >>= addNoise >>= rgNoise >>= forgetPink

ghci> plotDistribution (plotFile "allDist" $ PNG 400 300) allDist2

We can also use Haskell’s do notation to accomplish the same exact thing:

>allDist2' :: Categorical Double Marble >allDist2' = do > dp <- train bagOfMarbles > dp <- addNoise dp > dp <- rgNoise dp > dp <- forgetPink dp > return dp

(Since we’re using a custom Monad definition, do notation requires the RebindableSyntax extension.)

**Example 9
**

Do notation gives us a convenient way to preprocess multiple data sets into a single data set. Let’s create two new data sets and their corresponding distributions for us to work with:

> bag1 = [Red,Pink,Green,Blue,White] > bag2 = [Red,Blue,White] > > bag1dist = train bag1 :: Categorical Double Marble > bag2dist = train bag2 :: Categorical Double Marble

Now, we’ll create a third data set that is a weighted combination of bag1 and bag2. We will do this by repeated sampling. On every iteration, with a 20% probability we’ll sample from bag1, and with an 80% probability we’ll sample from bag2. Imperative pseudo-code for this algorithm is:

let comboDist be an empty distribution loop until desired accuracy achieved: let r be a random number from 0 to 1 if r > 0.2: sample dp1 from bag1 add dp1 to comboDist else: sample dp2 from bag2 add dp2 to comboDist

This sampling procedure will obviously not give us an exact answer. But since the categorical distribution supports weighted data points, we can use this simpler pseudo-code to generate an exact answer:

let comboDist be an empty distribution foreach datapoint dp1 in bag1: foreach datapoint dp2 in bag2: add dp1 with weight 0.2 to comboDist add dp2 with weight 0.8 to comboDist

Using do notation, we can express this as:

> comboDist :: Categorical Double Marble > comboDist = do > dp1 <- bag1dist > dp2 <- bag2dist > trainW [(0.2,dp1),(0.8,dp2)]

plotDistribution (plotFile "comboDist" $ PNG 400 300) comboDist

And because the Categorical functor takes constant time, constructing comboDist also takes constant time. The naive imperative algorithm would have taken time .

When combining multiple distributions this way, the number of data points in our final distribution will be the product of the number of data points in the initial distributions:

ghci> numdp combination 15

**Example 10
**

Finally, arbitrarily complex preprocessing functions can be written using Haskell’s do notation. And remember, no matter how complicated these functions are, their run time never depends on the number of elements in the initial data set.

This function adds uniform sampling noise to our bagOfMarbles, but only on those marbles that are also contained in bag2 above.

> comboDist2 :: Categorical Double Marble > comboDist2 = do > dp1 <- marblesDist > dp2 <- bag2dist > if dp1==dp2 > then addNoise dp1 > else return dp1

plotDistribution (plotFile "comboDist2" $ PNG 400 300) comboDist2

This application of monads to machine learning generalizes the monad used in probabilistic functional programming. The main difference is that PFP focused on manipulating already known distributions, not training them from data. Also, if you enjoy this kind of thing, you might be interested in the n-category cafe discussion on category theory in machine learning from a few years back.

In future posts, we’ll look at functors and monads for continuous distributions, multivariate distributions, and classifiers.

Subscribe to the RSS feed to stay tuned!

]]>Here’s a picture of our full chiller assembly. The internal chiller is on the right, and the external chiller is on the left.

The external chiller just sits around the outside of the boil pot. The pot’s handles keep the coil in place:

When we start the cooldown, water flows through the internal chiller, then through the external chiller. The external chiller has a number of holes cut into it. Water sprays out these hole and onto the outside of the pot:

This dramatically increases the surface area of water cooling. Heat is being transfered not just at the internal coils, but also along the whole pot. Here’s a zoomed out picture of the whole thing in action:

We only had to buy a 5 foot section of copper coil to wrap around the pot, and this cost about $5 at Lowes. I used a dremel to cut slots in the copper tubing about every 4 inches.

This external chilling reduced our cooling times from just over 30 minutes to just under 20 minutes. It was definitely worth the investment.

]]>