Proapplicative

gistfile1.txt

infixl 3 <+>

class Proapplicative p where
  constant :: b -> p Void b
  (<+>) :: p a (c -> d) -> p b c -> p (Either a b) d

instance Proapplicative (Forget r) where
  constant _ = Forget $ \nonsense -> case nonsense of {}

  Forget f <+> Forget g = Forget $ either f g

instance Proapplicative Either where
  constant = Right

  Left x  <+> _       = Left (Left x)
  Right _ <+> Left y  = Left (Right y)
  Right h <+> Right z = Right (h z)

instance Proapplicative Fold where
  constant x = Fold const x id

  Fold step1 begin1 final1 <+> Fold step2 begin2 final2 = Fold step begin final where
    step (Pair acc1 acc2) xOrY = case xOrY of
      Left x  -> Pair (step1 acc1 x) acc2
      Right y -> Pair acc1 (step2 acc2 y)
    begin = Pair begin1 begin2
    final (Pair acc1 acc2) = final1 acc1 (final2 acc2)

data Pair a b = Pair !a !b

testProapplicative :: Fold a d -> Fold b e -> Fold c f -> Fold (Either (Either a b) c) (d, e, f)
testProapplicative fold1 fold2 fold3 = (,,) <$> fold1 <+> fold2 <+> fold3