Skip to content

Instantly share code, notes, and snippets.

@luqui
Created February 13, 2013 11:28
Show Gist options
  • Select an option

  • Save luqui/4943974 to your computer and use it in GitHub Desktop.

Select an option

Save luqui/4943974 to your computer and use it in GitHub Desktop.
Free constructions
{-# LANGUAGE RankNTypes, TypeOperators #-}
data Monoid m = Monoid { mempty :: m, mappend :: m -> m -> m }
data Generator a m = Generator { monoid :: Monoid m, singleton :: a -> m }
newtype Free s = Free { getFree :: forall a. s a -> a }
mkMonoid :: (forall s. f s -> Monoid s) -> Monoid (Free f)
mkMonoid f = Monoid {
mempty = Free (mempty . f),
mappend = \a b -> Free $ \s -> mappend (f s) (getFree a s) (getFree b s)
}
freeMonoid :: Monoid (Free Monoid)
freeMonoid = mkMonoid id
mkGenerator :: (forall s. f s -> Generator a s) -> Generator a (Free f)
mkGenerator f = Generator {
monoid = mkMonoid (monoid . f),
singleton = \x -> Free $ \s -> singleton (f s) x
}
freeGenerator :: Generator a (Free (Generator a))
freeGenerator = mkGenerator id
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment