gistfile1.hs

class Group a where
  gempty :: a
  gappend :: a -> a -> a
  ginv :: a -> a

data FreeGroup a = FreeGroup { outFreeGroup :: forall m. Group m => (a -> m) -> m }

nil :: FreeGroup a
nil = FreeGroup (\_ -> gempty)

cons :: a -> FreeGroup a -> FreeGroup a
cons x xs = FreeGroup (\f -> f x `gappend` outFreeGroup xs f)

uncons :: a -> FreeGroup a -> FreeGroup a
uncons x xs = FreeGroup (\f -> ginv (f x) `gappend` outFreeGroup xs f)

instance Monad FreeGroup where
  return a = cons a nil
  g >>= f = FreeGroup (\h -> outFreeGroup g (\a -> outFreeGroup (f a) h))

-- A free group is a monad in two ways. One positive and one negative.
-- instance Monad FreeGroup where
--   return a = uncons a nil
--   g >>= f = FreeGroup (\h -> outFreeGroup g (\a -> outFreeGroup (f a) (inv . h)))