Working out the details of a type indexed free monad

Question

I\'ve been using a free monad to build a DSL. As part of the language, there is an input command, the goal is to reflect what types are expected by the input primit

Answer 1

I have a new solution that is simple and quite generally applicable.

So far in the thread we've used monads indexed by a monoid, but here I rely on the other popular notion of an indexed monad, the one that has typestate transitions (Hoare logic-style):

    return :: a -> m i i a
    (>>=) :: m i j a -> (a -> m j k b) -> m i k b

I believe the two approaches are equivalent (at least in theory), since we get the Hoare monad by indexing with the endomorphism monoid, and we can also go in the opposite direction by CPS encoding the monoidal appends in the state transitions. In practice, Haskell's type-level and kind-level language is rather weak, so moving back-and-forth between the two representations is not an option.

There is a problem though with the above type for >>=: it implies that we must compute the typestate in a top-down order, i. e. it forces the following definition for IxFree:

data IxFree f i j a where
  Pure :: a -> IxFree f i i a
  Free :: f i j (IxFree f j k a) -> IxFree f i k a

So, if we have a Free exp expression, then we first transition from i to j following the constructor of exp, and then get from j to k by checking the subexperssions of exp. This means that if we try to accumulate the input types in a list, we end up with a reversed list:

-- compute transitions top-down
test = do
  (x :: Int) <- input       -- prepend Int to typestate
  (y :: String) <- input    -- prepend String to typestate
  return ()                 -- do nothing         

If we instead appended the types to the end of the list, the order would be right. But making that work in Haskell (especially making eval work) would require a gruelling amount of proof-writing, if it's even possible.

Let's compute the typestate bottom-up instead. It makes all kinds of computations where we build up some data structure depending on the syntax tree much more natural, and in particular it makes our job very easy here.

{-# LANGUAGE
    RebindableSyntax, DataKinds,
    GADTs, TypeFamilies, TypeOperators,
    PolyKinds, StandaloneDeriving, DeriveFunctor #-}

import Prelude hiding (Monad(..))

class IxFunctor (f :: ix -> ix -> * -> *) where
    imap :: (a -> b) -> f i j a -> f i j b

class IxFunctor m => IxMonad (m :: ix -> ix -> * -> *) where
    return :: a -> m i i a
    (>>=) :: m j k a -> (a -> m i j b) -> m i k b -- note the change of index orders

    (>>) :: m j k a -> m i j b -> m i k b -- here too
    a >> b = a >>= const b

    fail :: String -> m i j a
    fail = error

data IxFree f i j a where
  Pure :: a -> IxFree f i i a
  Free :: f j k (IxFree f i j a) -> IxFree f i k a -- compute bottom-up

instance IxFunctor f => Functor (IxFree f i j) where
  fmap f (Pure a)  = Pure (f a)
  fmap f (Free fa) = Free (imap (fmap f) fa)

instance IxFunctor f => IxFunctor (IxFree f) where
  imap = fmap

instance IxFunctor f => IxMonad (IxFree f) where
  return = Pure
  Pure a  >>= f = f a
  Free fa >>= f = Free (imap (>>= f) fa)

liftf :: IxFunctor f => f i j a -> IxFree f i j a
liftf = Free . imap Pure

Now implementing Action becomes simple.

data ActionF i j next where
  Input  :: (a -> next) -> ActionF i (a ': i) next
  Output :: String -> next -> ActionF i i next

deriving instance Functor (ActionF i j)                                      
instance IxFunctor ActionF where
  imap = fmap

type family (++) xs ys where -- I use (++) here only for the type synonyms
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

type Action' xs rest = IxFree ActionF rest (xs ++ rest)
type Action xs a = forall rest. IxFree ActionF rest (xs ++ rest) a  

input :: Action '[a] a
input = liftf (Input id)

output :: String -> Action '[] ()
output s = liftf (Output s ())

data HList i where
  HNil :: HList '[]
  (:::) :: h -> HList t -> HList (h ': t)
infixr 5 :::

eval :: Action' xs r a -> HList xs -> [String]
eval (Pure a)              xs         = []
eval (Free (Input k))      (x ::: xs) = eval (k x) xs
eval (Free (Output s nxt)) xs         = s : eval nxt xs

addTwice :: Action [Int, Int] ()
addTwice = do
  x <- input
  y <- input
  output (show $ x + y)

To make things less confusing for users, I introduced type synonyms with friendlier index schemes: Action' xs rest a means that the action reads from xs and may be followed by actions containing rest reads. Action is a type synonym equivalent to the one appearing in the thread question.

We can implement a variety of DSL-s with this approach. The reversed typing order gives it a bit of a spin, but we can do the usual indexed monads all the same. Here's the indexed state monad, for example:

data IxStateF i j next where
  Put :: j -> next -> IxStateF j i next
  Get :: (i -> next) -> IxStateF i i next

deriving instance Functor (IxStateF i j)
instance IxFunctor IxStateF where imap = fmap

put s = liftf (Put s ())
get   = liftf (Get id)

type IxState i j = IxFree IxStateF j i

evalState :: IxState i o a -> i -> (a, o)
evalState (Pure a)         i = (a, i)
evalState (Free (Get k))   i = evalState (k i) i
evalState (Free (Put s k)) i = evalState k s

test :: IxState Int String ()
test = do
  n <- get
  put (show $ n * 100)

Now, I believe this approach is a fair bit more practical than indexing with monoids, because Haskell doesn't have kind classes or first-class type level functions that would make the monoid approach palatable. It would be nice to have a VerifiedMonoid class, like in Idris or Agda, which includes correctness proofs besides the usual methods. That way we could write a FreeIx that is generic in the choice of the index monoid, and not restricted to lifted lists or something else.