Common functionality for different types

I have identified some common functionality in two of my datatypes, so like any programmer worth his salt I tried to factor it out:

module Binary where

import Control.Applicative
import Data.Function
import Control.Monad


class Binary f where
  yes :: f a a
  no  :: f a b
  (..>) :: f a b -> f b c -> f a c

  yes' :: f a ()
  (~.>) :: f a b -> f a c -> f a c


try :: (Binary f, Alternative (f a)) => f a a -> f a a
try = (<|> yes)

try' :: (Binary f, Alternative (f a)) => f a () -> f a ()
try' = (<|> yes')

(.>) :: (Binary f, Alternative (f c)) => f a c -> f c c -> f a c
a .> b = a ..> try b

(~>) :: (Binary f, Alternative (f a)) => f a b -> f a () -> f a ()
a ~> b = a ~.> try' b

greedy :: (Binary f, Alternative (f a)) => f a a -> f a a
greedy = fix $ ap (.>)

greedy' :: (Binary f, Alternative (f a)) => f a () -> f a ()
greedy' = fix $ ap (~>)

As you can see, the types of yes and yes', and ..> and ~.> are slightly different - they need to be for me to write instances - and so I end up with duplicate functions.

Is there a way I can get rid of yes' and ~.>, and still make an instance of Binary with those types?

Here are my two instances:

module Example where

import Binary

import Prelude hiding ((.), id)
import Control.Category
import Data.List.Zipper as Z
import Control.Monad.Trans.Maybe
import Control.Monad.State


newtype Opt a b = Opt { runOpt :: a -> Maybe b }

instance Category Opt where
  id = yes
  (Opt f) . (Opt g) = Opt $ g >=> f

instance Binary Opt where
  yes = Opt Just
  no = Opt $ const Nothing
  (..>) = (>>>)

---------

type Tape = Zipper
newtype Machine a b = Machine { unMachine :: MaybeT (State (Tape a)) b }

instance Functor (Machine a) where
  fmap f (Machine x) = Machine $ f <$> x

instance Applicative (Machine a) where
  pure = Machine . pure
  (Machine f) <*> (Machine x) = Machine $ f <*> x

instance Monad (Machine a) where
  (Machine a) >>= f = Machine $ a >>= unMachine <$> f

instance Binary Machine where
  no = Machine mzero
  yes' = pure ()
  a ~.> b = a >> b

I think there is a subtle inconsistency in your two instances -- that is, Opt and Machine do not quite have enough in common to share this much structure. For example, the methods

yes :: f a a
(..>) :: f a b -> f b c -> f a c

are essentially a Category, as you have noticed (though I would simply make Category a superclass of Binary instead of duplicating those methods). But Machine is not a category as it does not support composition. Also, Opt is a profunctor (contravariant in its first argument, covariant in its second), whereas Machine is instead invariant on its first argument. These are my hints that something needs to be changed before you try to abstract over these types.

My suspicion is that there is a missing parameter to Machine, and the state parameter is actually external to the Binary abstraction. Try using the Kleisli category of your monad.

newtype Machine s a b = Machine { unMachine :: a -> MaybeT (State (Tape s)) b }

Now Machine s is a Category and the same sort of Binary that Opt is, and you don't need any of the primed combinators, and you can express any old Machine a bs as Machine a () b if you need to, but you can also probably generalize them.

In fact, the abstraction you are looking for may simply be ArrowZero. Arrow has a bit more structure than Category, so you should consider whether the rest of Arrow is applicable to your problem. If so, you have just opened a new toolbox of combinators, and you don't need to write any instances by hand because they are all covered by:

 type Opt = Kleisli Maybe
 type Machine s = Kleisli (MaybeT (State s))

(or in newtype style with GeneralizedNewtypeDeriving if you prefer)