Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add churchy free Applicative transformers #162

Open
treeowl opened this issue Sep 5, 2017 · 3 comments
Open

Add churchy free Applicative transformers #162

treeowl opened this issue Sep 5, 2017 · 3 comments

Comments

@treeowl
Copy link

treeowl commented Sep 5, 2017

The free Applicative transformers aren't exactly well documented, and I have no sense of the efficiency concerns, but this seems to be an obvious Church version:

newtype ApT f g b = ApT {getApT :: forall h.
     (Applicative h)
  => (forall a. f a -> h a)
  -> (forall a. g (h a) -> h a)
  -> h b}

instance Functor (ApT f g) where
  fmap f (ApT x) = ApT $ \p q -> f <$> x p q

instance Applicative g => Applicative (ApT f g) where
  pure x = ApT $ \_ q -> q (pure (pure x))
  ApT fs <*> ApT xs = ApT $ \p q -> fs p q <*> xs p q

liftApT :: f a -> ApT f g a
liftApT fa = ApT $ \p _ -> p fa

liftApO :: Functor g => g a -> ApT f g a
liftApO ga = ApT $ \_ q -> q $ fmap pure ga

runApT :: Applicative h => (forall a. f a -> h a) -> (forall a. g (h a) -> h a) -> ApT f g b -> h b
runApT f g (ApT x) = x f g

hoistApT :: (forall a. f a -> f' a) -> ApT f g b -> ApT f' g b
hoistApT f (ApT x) = ApT $ \p -> x (p . f)

transApT :: (forall a. g a -> g' a) -> ApT f g b -> ApT f g' b
transApT f (ApT x) = ApT $ \p q -> x p (q . f)

By the way: it would be very nice to document the distinction between ApF and ApT.

@treeowl
Copy link
Author

treeowl commented Sep 5, 2017

Oh, and

runAlt :: (Alternative g, Foldable t) => (forall x. f x -> g x) -> ApT f t a -> g a
runAlt f (ApT x) = x f $ getAlt . foldMap Alt

@treeowl
Copy link
Author

treeowl commented Sep 5, 2017

And also (probably?)

instance Alternative g => Alternative (ApT f g) where
  empty = ApT $ \_ q -> q empty
  ApT x <|> ApT y = ApT $ \p q -> q $
    getCompose (x (Compose . pure . p) (Compose . fmap (q . getCompose))) <|>
    getCompose (y (Compose . pure . p) (Compose . fmap (q . getCompose)))

@treeowl
Copy link
Author

treeowl commented Sep 5, 2017

And

joinApT :: Monad m => ApT f m a -> m (ApT f Identity a)
joinApT (ApT x) = getCompose $ x (Compose . pure . liftApT) (Compose . (>>= getCompose))

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

No branches or pull requests

1 participant