Thursday, October 21, 2021

Co-Applicative programming style

coapplicative

This post showcases an upcoming addition to the contravariant package that permits programming in a “co-Applicative” (Divisible) style that greatly resembles Applicative style.

This post assumes that you are already familiar with programming in an Applicative style, but if you don’t know what that is then I recommend reading:

Example

The easiest way to motivate this is through a concrete example:

{-# LANGUAGE NamedFieldPuns #-}

import Data.Functor.Contravariant (Predicate(..), (>$<))
import Data.Functor.Contravariant.Divisible (Divisible, divided)

nonNegative :: Predicate Double
nonNegative = Predicate (0 <=)

data Point = Point { x :: Double, y :: Double, z :: Double }

nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >$< nonNegative >*< nonNegative >*< nonNegative
  where
    adapt Point{ x, y, z } = (x, (y, z))

-- | This operator will be available in the next `contravariant` release
(>*<) :: Divisible f => f a -> f b -> f (a, b)
(>*<) = divided

infixr 5 >*<

This code takes a nonNegative Predicate on Doubles that returns True if the double is non-negative and then uses co-Applicative (Divisible) style to create a nonNegativeOctant Predicate on Points that returns True if all three coordinates of a Point are non-negative.

The key part to zoom in on is the nonNegativeOctant Predicate, whose implementation superficially resembles the Applicative style that we know and love:

nonNegativeOctant = adapt >$< nonNegative >*< nonNegative >*< nonNegative

The difference is that instead of the <$> and <*> operators we use >$< and >*<, which are their evil twins dual operators1. For example, you can probably see the resemblance to the following code that uses Applicative style:

readDouble :: IO Double
readDouble = readLn

readPoint :: IO Point
readPoint = Point <$> readDouble <*> readDouble <*> readDouble

Types

I’ll walk through the types involved to help explain how this style works.

First, we will take this expression:

nonNegativeOctant = adapt >$< nonNegative >*< nonNegative >*< nonNegative

… and explicitly parenthesize the expression instead of relying on operator precedence and associativity:

nonNegativeOctant = adapt >$< (nonNegative >*< (nonNegative >*< nonNegative))

So the smallest sub-expression is this one:

nonNegative >*< nonNegative

… and given that the type of nonNegative is:

nonNegative :: Predicate Double

… and the type of the (>*<) operator is:

(>*<) :: Divisible f => f a -> f b -> f (a, b)

… then we can specialize the f in that type to Predicate (since Predicate implements the Divisible class):

(>*<) :: Predicate a -> Predicate b -> Predicate (a, b)

… and further specialize a and b to Double:

(>*<) :: Predicate Double -> Predicate Double -> Predicate (Double, Double)

… and from that we can conclude that the type of our subexpression is:

nonNegative >*< nonNegative
    :: Predicate (Double, Double)

In other words, nonNegative >*< nonNegative is a Predicate whose input is a pair of Doubles.

We can then repeat the process to infer the type of this larger subexpression:

nonNegative >*< (nonNegative >*< nonNegative))
    :: Predicate (Double, (Double, Double))

In other words, now the input is a nested tuple of three Doubles.

However, we want to work with Points rather than nested tuples, so we pre-process the input using >$<:

adapt >$< (nonNegative >*< (nonNegative >*< nonNegative))
  where
    adapt :: Point -> (Double, (Double, Double))
    adapt Point{ x, y, z } = (x, (y, z))

… and this works because the type of >$< is:

(>$<) :: Contravariant f => (a -> b) -> f b -> f a

… and if we specialize f to Predicate, we get:

(>$<) :: (a -> b) -> Predicate b -> Predicate a

… and we can further specialize a and b to:

(>$<)
    :: (Point -> (Double, (Double, Double)))
    -> Predicate (Double, (Double, Double))
    -> Predicate Point

… which implies that our final type is:

nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >$< (nonNegative >*< (nonNegative >*< nonNegative))
  where
    adapt Point{ x, y, z } = (x, (y, z))

Duals

We can better understand the relationship between the two sets of operators by studying their types:

-- | These two operators are dual to one another:
(<$>) :: Functor       f => (a -> b) -> f a -> f b
(>$<) :: Contravariant f => (a -> b) -> f b -> f a

-- | These two operators are similar in spirit, but they are not really dual:
(<*>) :: Applicative f => f (a -> b) -> f a -> f b
(>*<) :: Divisible   f => f a        -> f b -> f (a, b)

Okay, so (>*<) is not exactly the dual operator of (<*>). (>*<) is actually dual to liftA2 (,)2:

(>*<)      :: Divisible   f => f a -> f b -> f (a, b)
liftA2 (,) :: Applicative f => f a -> f b -> f (a, b)

In fact, if we were to hypothetically redefine (<*>) to be liftA2 (,) then we could write Applicative code that is even more symmetric to the Divisible code (albeit less ergonomic):

import Control.Applicative (liftA2)
import Prelude hiding ((<*>))

(<*>) = liftA2 (,)

infixr 5 <*>

readDouble :: IO Double
readDouble = readLn

readPoint :: IO Point
readPoint = adapt <$> readDouble <*> readDouble <*> readDouble
  where
    adapt (x, (y, z)) = Point{ x, y, z }

-- Compare to:
nonNegativeOctant :: Predicate Point
nonNegativeOctant = adapt >$< nonNegative >*< nonNegative >*< nonNegative
  where
    adapt Point{ x, y, z } = (x, (y, z))

It would be nice if we could create a (>*<) operator that was dual to the real (<*>) operator, but I could not figure out a good way to do this.

If you didn’t follow all of that, the main thing you should take away from this going into the next section is:

  • the Contravariant class is the dual of the Functor class
  • the Divisible class is the dual of the Applicative class

Syntactic sugar

GHC supports the ApplicativeDo extension, which lets you use do notation as syntactic sugar for Applicative operators. For example, we could have written our readPoint function like this:

{-# LANGUAGE ApplicativeDo #-}

readPoint :: IO Point
readPoint = do
    x <- readDouble
    y <- readDouble
    z <- readDouble
    return Point{ x, y, z }

… which behaves in the exact same way. Actually, we didn’t even need the ApplicativeDo extension because IO has a Monad instance and anything that has a Monad instance supports do notation without any extensions.

However, the ApplicativeDo language extension does change how the do notation is desugared. Without the extension the above readPoint function would desugar to:

readPoint =
    readDouble >>= \x ->
    readDouble >>= \y ->
    readDouble >>= \z ->
    return Point{ x, y, z }

… but with the ApplicativeDo extension the function instead desugars to only use Applicative operations instead of Monad operations:

-- I don't know the exact desugaring logic, but I imagine it's similar to this:
readPoint = adapt <$> readDouble <*> readDouble <*> readDouble
  where
    adapt x y z = Point{ x, y, z }

So could there be such a thing as “DivisibleDo” which would introduce syntactic sugar for Divisible operations?

I think there could be such an extension, and there are several ways you could design the user experience.

One approach would be to permit code like this:

{-# LANGUAGE DivisibleFrom #-}

nonNegativeOctant :: Predicate Point
nonNegativeOctant =
    from Point{ x, y, z }
        x -> nonNegative
        y -> nonNegative
        z -> nonNegative

… which would desugar to the original code that we wrote:

nonNegativeOctant = adapt >$< nonNegative >*< nonNegative >*< nonNegative
  where
    adapt Point{ x, y, z } = (x, (y, z))

Another approach could be to make the syntax look exactly like do notation, except that information flows in reverse:

{-# LANGUAGE DivisibleDo #-}

nonNegativeOctant :: Predicate Point
nonNegativeOctant = do
    x <- nonNegative
    y <- nonNegative
    r <- nonNegative
    return Point{ x, y, z } -- `return` here would actually be a special keyword

I assume that most people will prefer the from notation, so I’ll stick to that for now.

If we were to implement the former DivisibleFrom notation then the Divisible laws stated using from notation would become:

-- Left identity
  from x
      x -> m
      x -> conquer

= m


-- Right identity
  from x
      x -> conquer
      x -> m

= m

-- Associativity
  from (x, y, z)
      (x, y) -> from (x, y)
                    x -> m
                    y -> n
      z -> o

= from (x, y, z)
      x -> m
      (y, z) -> from (y, z)
                    y -> n
                    z -> o

= from (x, y, z)
      x -> m
      y -> n
      z -> o

This explanation of how DivisibleFrom would work is really hand-wavy, but if people were genuinely interested in such a language feature I might take a stab at making the semantics of DivisibleFrom sufficiently precise.

History

The original motivation for the (>*<) operator and Divisible style was to support compositional RecordEncoders for the dhall package.

Dhall’s Haskell API defines a RecordEncoder type which specifies how to convert a Haskell record to a Dhall syntax tree, and we wanted to be able to use the Divisible operators to combine simpler RecordEncoders into larger RecordEncoders, like this:

data Project = Project
    { name        :: Text
    , description :: Text
    , stars       :: Natural
    }

injectProject :: Encoder Project
injectProject =
  recordEncoder
    ( adapt >$< encodeFieldWith "name"        inject
            >*< encodeFieldWith "description" inject
            >*< encodeFieldWith "stars"       inject
    )
  where
    adapt Project{..} = (name, (description, stars))

The above example illustrates how one can assemble three smaller RecordEncoders (each of the encodeFieldWith functions) into a RecordEncoder for the Project record by using the Divisible operators.

If we had a DivisibleFrom notation, then we could have instead written:

injectProject =
    recordEncoder from Project{..}
        name        -> encodeFieldWith "name"        inject
        description -> encodeFieldWith "description" inject
        stars       -> encodeFieldWith "stars"       inject

If you’d like to view the original discussion that led to this idea you can check out the original pull request.

Conclusion

I upstreamed this (>*<) operator into the contravariant package, which means that you’ll be able to use the trick outlined in this post after the next contravariant release.

Until then, you can define your own (>*<) operator inline within your own project, which is what dhall did while waiting for the operator to be upstreamed.


  1. Alright, they’re not categorically dual in a rigorous sense, but I couldn’t come up with a better term to describe their relationship to the original operators.↩︎

  2. I feel like liftA2 (,) should have already been added to Control.Applicative by now since I believe it’s a pretty fundamental operation from a theoretical standpoint.↩︎

3 comments:

  1. I guess that this approach is not exactly dual to the `Applicative` one because your are not applying it to "functions". Applicative works with functions of the shape `a -> b -> c`, which is, functions taking two inputs. The dual could be seen as function which return two outputs, i.e. functions with the type `a -> (b, c)`. Now if you have a `pb :: Predicate b` and a `pc :: Predicate c` and a function `f :: a -> (b, c)`, you could obtain a `Predicate a` doing `f >$< pb >*< pc`.

    For example this works

    ```haskell
    data Point = Point Int Int

    f :: Point -> (Int, Int)
    f (Point x y) = (x, y)

    type Predicate a = a -> Bool

    positive :: Predicate Int
    positive = (>= 0)

    (>$<) :: (a -> b) -> Predicate b -> Predicate a
    (>$<) f p = p . f

    infixl 4 >$<

    (>*<) :: Predicate a -> Predicate b -> Predicate (a, b)
    (>*<) pa pb (a, b) = pa a && pb b

    infixl 5 >*<

    p :: Predicate Point
    p = f >$< positive >*< positive
    ```

    ReplyDelete
  2. With respect to encoding and decoding of records, you might be interested in my (Scala, never got around to porting it to Haskell) Xenomorph project: https://github.com/nuttycom/xenomorph - there, rather than define encoders and decoders directly, I use free applicatives to capture the structure of an ADT and then derive the encoding and decoding from that structure value.

    ReplyDelete
  3. I don't really see a way to make a proper dual to `<*>`, but you can certainly make the code more ergonomic by hiding `adapt`. Using Generics, you can write:

    ```haskell
    adapt :: (Generic t, GenericAdapt (Rep t)) => t -> ListToPair (TList (Rep t))
    adapt = vecToPairs . gAdapt . from

    type family ListToPair xs where
    ListToPair '[] = ()
    ListToPair '[x] = x
    ListToPair (x ': (y ': ys)) = (x, ListToPair (y ': ys))

    class GenericAdapt f where
    type TList f :: [Type]
    gAdapt :: f x -> Vec (TList f)

    instance (GenericAdapt f, GenericAdapt g) => GenericAdapt (f :*: g) where
    type TList (f :*: g) = Append (TList f) (TList g)
    gAdapt (f :*: g) = vecAppend (gAdapt f) (gAdapt g)

    instance GenericAdapt x => GenericAdapt (D1 m x) where
    type TList (D1 m x) = TList x
    gAdapt (M1 xs) = gAdapt xs

    instance GenericAdapt x => GenericAdapt (C1 m x) where
    type TList (C1 m x) = TList x
    gAdapt (M1 xs) = gAdapt xs

    instance GenericAdapt U1 where
    type TList U1 = '[]
    gAdapt U1 = Nil

    instance GenericAdapt (S1 m (Rec0 t)) where
    type TList (S1 m (Rec0 t)) = '[t]
    gAdapt (M1 (K1 x)) = Cons x Nil


    data Vec lst where
    Nil :: Vec '[]
    Cons :: x -> Vec xs -> Vec (x ': xs)

    type family Append xs ys :: [Type] where
    Append '[] ys = ys
    Append (x ': xs) ys = x ': Append xs ys

    vecAppend :: Vec lst1 -> Vec lst2 -> Vec (Append lst1 lst2)
    vecAppend Nil ys = ys
    vecAppend (Cons x xs) ys = Cons x (vecAppend xs ys)

    vecToPairs :: Vec lst -> ListToPair lst
    vecToPairs Nil = ()
    vecToPairs (Cons x Nil) = x
    vecToPairs (Cons x xs@(Cons _ _)) = (x, vecToPairs xs)
    ```
    (There's probably an existing Vec type that supports this.)

    This will work for any record type that derives Generic. But, you can even be a little cheeky and go one step further by making your own custom `>$<` function that uses adapt, as in:

    ```haskell
    infixl 4 >$<
    (>$<)
    :: (Generic t, GenericAdapt (Rep t), Contravariant f)
    => Constructor (TList (Rep t)) t
    -> (f (ListToPair (TList (Rep t))) -> f t)
    _ >$< a = contramap adapt a

    type family Constructor xs t where
    Constructor '[] t = t
    Constructor '[x] t = x -> t
    Constructor (x ': (y ': ys)) t = x -> Constructor (y ': ys) t
    ```
    With this setup, you can write code that _looks_ like it's dual to real applicative code:

    ```haskell
    nonNegativeOctant :: Predicate Point
    nonNegativeOctant = Point >$< nonNegative >*< nonNegative >*< nonNegative
    ```

    ReplyDelete