Deriving LogicT from Codensity

LogicT.hs

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE UndecidableInstances #-}
module LogicT where

import Control.Applicative
import Control.Monad
import Data.Monoid

newtype Codensity m a = Codensity { runCodensity :: forall b. (a -> m b) -> m b }

instance Functor (Codensity k) where
  fmap f (Codensity m) = Codensity (\k -> m (\x -> k (f x)))

instance Applicative (Codensity f) where
  pure x = Codensity (\k -> k x)
  Codensity f <*> Codensity g = Codensity (\bfr -> f (\ab -> g (\x -> bfr (ab x))))

instance Monad (Codensity f) where
  return = pure
  m >>= k = Codensity (\c -> runCodensity m (\a -> runCodensity (k a) c))

-- we can get the behaviour of the Alternative instance on Codensity in the
-- kan-extensions library by setting m to be Data.Monoid.Alt v
instance (forall r. Monoid (m r)) => Alternative (Codensity m) where
  empty = Codensity (\_ -> mempty)
  Codensity ka1 <|> Codensity ka2 = Codensity (\za -> ka1 za <> ka2 za)

instance (forall r. Monoid (m r)) => MonadPlus (Codensity m)

newtype MkLogicT m a = MkLogicT (m a -> m a)
  deriving (Semigroup, Monoid) via Endo (m a)

newtype LogicT m a = LogicT { runLogicT :: forall r. (a -> m r -> m r) -> m r -> m r }
  deriving (Functor, Applicative, Monad, Alternative, MonadPlus) via Codensity (MkLogicT m)