CheckClosed.hs

{-# LANGUAGE TypeOperators, FlexibleContexts #-}
import GHC.Generics ((:.:)(..))
import Control.Applicative (liftA2)

class Applicative f => Selective f where
  select :: f (Either a b) -> f (a -> b) -> f b
  select fe fab = either id (uncurry (flip ($))) <$> biselect (either Right Left <$> fe) (Right <$> fab)
  biselect :: f (Either a b) -> f (Either a c) -> f (Either a (b, c))

class Applicative f => CheckClosed f where
  checkClosed :: f a -> Maybe (f b)

biselectC :: (Applicative f, CheckClosed (f :.: Either a)) => f (Either a b) -> f (Either a c) -> f (Either a (b, c))
biselectC fab fac = case checkClosed (Comp1 fab) of
  Just (Comp1 fex) -> fex
  Nothing -> liftA2 (liftA2 (,)) fab fac