Applicative for a user defined type

Question

I'm trying to write Applicative for this type

data Choice a = ColumnA a | ColumnB a

I wrote a Functor instance:

instance Functor Choice where 
  fmap f (ColumnA a ) = (ColumnA (f a) )
  fmap f (ColumnB a ) = (ColumnB (f a) ) 

Now I want to write Applicative where ColumnB is considered "a correct value" and ColumnA is considered to be some kind of an error.

I tried

instance Applicative Choice where
    pure             =  ColumnB  
    ColumnB f  <*>  r  =  fmap f r
    ColumnA f  <*>  _  =  ColumnA  f   --- this does not work 

How can I make it work ?

Answer 1

Let's rename your data constructors to express your intent properly, as

data Choice a = Bad a | Good a

Your Functor instance keeps the taint on the values,

instance Functor Choice where 
  fmap f (Bad  x)  =  Bad  (f x) 
  fmap f (Good x)  =  Good (f x) 

so let's just do the same for the Applicative, without being skimpy with our clauses:

instance Applicative Choice where
    pure              x  =  Good    x     -- fmap f == (pure f <*>) is the Law
    Good f  <*>  Good x  =  Good (f x)
    Good f  <*>  Bad  x  =  Bad  (f x)
    Bad  f  <*>  Good x  =  Bad  (f x)
    Bad  f  <*>  Bad  x  =  Bad  (f x)

As was pointed in the comments, this interprets Choice a as isomorphic to Writer All a, meaning, Choice a values are really just like (Bool, a) with (False, x) corresponding to Bad x and (True, x) corresponding to Good x. Naturally we only consider values to be Good if everything in their provenance was Good as well.

Answer 2

If ColumnA is considered some kind of error, you can not let it wrap an a value. Indeed. The idea of (<*>) is that it takes a Choice (x -> y) and Choice x, and returns a Choice y. But if you have a ColumnA that wraps a function of type x -> y, and you have at the right hand a Choice x, then it thus should return a Choice y, not a Choice x.

What you could do is define a type with two type parameters, for example:

data Choice a b = ColumnA a | ColumnB b

then you only perform a mapping over the ColumnB b data constructor:

instance Functor (Choice a) where
    fmap _ (ColumnA e) = ColumnA e
    fmap f (ColumnB x) = ColumnB (f x)

and then we can define an Applicative instance as:

instance Applicative (Choice a) where
    pure = ColumnB
    ColumnB f <*> ColumnB x = ColumnB (f x)
    ColumnA e <*> _ = ColumnA e
    _ <*> ColumnA e = ColumnA e

Such instance for a Functor and Applicative however already exist: this is how it is defined on the Either data type.

Answer 3

I made a package for deriving Applicative for sum types:idiomatic.

Choice can be biased towards the left or the right, if it is biased towards the left then ChoiceA is the pure constructor and combining A an B defects to ChoiceB:

{-# Language DerivingVia #-}
{-# Language DerivingStrategies #-}
{-# Language DeriveGeneric #-}
{-# Language DataKinds  #-}

import Generic.Applicative
import GHC.Generics

data Choice a = ColumnA a | ColumnB a
  deriving 
  stock (Show, Generic1)

  -- pure :: a -> Choice a
  -- pure = ColumnA
  -- 
  -- liftA2 :: (a -> b -> c) -> (Choice a -> Choice b -> Choice c)
  -- liftA2 (·) (ColumnA a) (ColumnA a') = ColumnA (a · a')
  -- liftA2 (·) (ColumnA a) (ColumnB b)  = ColumnB (a · b)
  -- liftA2 (·) (ColumnB b) (ColumnA a)  = ColumnB (b · a)
  -- liftA2 (·) (ColumnB b) (ColumnB b') = ColumnB (b · b')
  deriving (Functor, Applicative)
  via Idiomatically Choice '[LeftBias Id]

and right-bias means ChoiceB is the pure constructor and combining A an B defects to ChoiceA:

  -- pure :: a -> Choice a
  -- pure = ColumnB
  -- 
  -- liftA2 :: (a -> b -> c) -> (Choice a -> Choice b -> Choice c)
  -- liftA2 (·) (ColumnA a) (ColumnA a') = ColumnA (a · a')
  -- liftA2 (·) (ColumnA a) (ColumnB b)  = ColumnA (a · b)
  -- liftA2 (·) (ColumnB b) (ColumnA a)  = ColumnA (b · a)
  -- liftA2 (·) (ColumnB b) (ColumnB b') = ColumnB (b · b')
  deriving (Functor, Applicative)
  via Idiomatically Choice '[RightBias Id]