import Control.Monad

data Pair a = P a a deriving (Show, Eq)

true, false :: Pair a -> a
true  (P a _) = a
false (P _ b) = b

instance Monad Pair where
  return x = P x x
  P a b >>= f = P (true $ f a) (false $ f b)


-- GS is a monad
--
data GS a = GS { unGS :: Pair [a] } deriving (Show, Eq)

instance Monad GS where
  return = GS . return . return
  GS pair >>= f = GS $ do xs <- pair
                          P (concat [true  . unGS . f $ x | x <- xs])
                            (concat [false . unGS . f $ x | x <- xs])


-- SG isn't a monad
--
data SG a = SG { unSG :: [Pair a] } deriving (Show, Eq)

returnSG :: a -> SG a
returnSG x = SG [P x x]

(>>>=) :: Eq b => SG a -> (a -> SG b) -> SG b
SG sgx >>>= f = SG $ fmap join . join $ sequence <$> (fmap (unSG . f) <$> sgx)

main = print $ returnSG 0 >>>= \x -> SG $ [return x] ++ [return 1]


-- BTW this doesn't help
--
sequenceX :: (Eq a, MonadPlus m) => Pair (m a) -> m (Pair a)
sequenceX (P ma mb) = do a <- ma
                         b <- mb
                         if a == b then return $ P a b else mzero







{- crufty boilerplate -}

instance Applicative Pair where
  pure = return
  ff <*> xx = do f <- ff
                 x <- xx
                 return $ f x

instance Functor Pair where
  fmap f xx = pure f <*> xx

instance Foldable Pair where
  foldr f z (P a b) = f a $ f b z

instance Traversable Pair where
  traverse f (P a b) = P <$> f a <*> f b

instance Applicative GS where
  pure = return
  ff <*> xx = do f <- ff
                 x <- xx
                 return $ f x

instance Functor GS where
  fmap f xx = pure f <*> xx