计算一个类型索引的免费monad的细节。

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 primitive at the type level for additional safety.

我一直在使用免费的monad来构建DSL。作为语言的一部分，有一个输入命令，其目标是反映输入原语在类型级别上的期望类型，以获得额外的安全性。

For example, I want to be able to write the following program.

例如，我希望能够编写下面的程序。

concat :: Action '[String, String] ()
concat = do
  (x :: String) <- input
  (y :: String) <- input 
  output $ x ++ " " ++ y

Along with an evaluation function

还有一个评价函数。

eval :: Action params res -> HList params -> [String]
eval = ...

Which works in the following way..

它的工作原理如下

> eval concat ("a" `HCons` "b" `HCons` HNil)
["a b"]

Here's what I have so far.

这是我目前所拥有的。

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

type family Append (a :: [k]) (b :: [k]) :: [k] where
  Append ('[]) l = l
  Append (e ': l) l' = e ': (Append l l')

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

instance Functor ActionF where
  fmap f (Input c) = Input (fmap f c)
  fmap f (Output s n) = Output s (f n)

data FreeIx f i a where
  Return :: a -> FreeIx f '[] a
  Free :: f (FreeIx f i a) -> FreeIx f i a

type Action i a = FreeIx ActionF i a

liftF :: Functor f => f a -> FreeIx f i a
liftF = Free . fmap Return

input :: forall a . Action '[a] a
input = liftF (Input id)

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

bind :: Functor f => FreeIx f t a -> (a -> FreeIx f v b) -> FreeIx f (Append t v) b
bind (Return a) f = f a
bind (Free x) f   = Free (fmap (flip bind f) x)

The problem is that liftF does not type check.

问题是liftF不类型检查。

liftF :: Functor f => Proxy i -> f a -> FreeIx f i a
liftF p = Free . fmap Return

Is this the correct approach?

这是正确的方法吗?

I thought some inspiration might come from the effect monad package. This is what led to the definition of Return and Free.

我认为一些灵感可能来自monad包装的效果。这导致了回归和*的定义。

For some more backstory: I've seen in several places that users will define DSLs in this way and then define an evaluation function eval :: Action a -> [String] -> a or something similar. The clear problem with this approach is that all arguments must have the same type and there is no static guarantee that the correct number of arguments will be supplied. This is an attempt to solve this problem.

更多的背景故事:我在几个地方看到，用户会用这种方式定义DSLs，然后定义一个评估函数eval:: Action a -> [String] -> a或类似的东西。这种方法的明显问题是，所有的参数必须具有相同的类型，并且没有静态的保证提供正确的参数数量。这是试图解决这个问题。

6 个解决方案

#1

I have found a satisfactory solution to this problem. Here's a sneak peek at the ultimate result:

我已经找到了一个令人满意的解决方法。这是对最终结果的一瞥:

addTwo = do
  (x :: Int) <- input
  (y :: Int) <- input 
  output $ show (x + y)

eval (1 ::: 2 ::: HNil) addTwo = ["3"]

Accomplishing this requires a large number of steps. First, we need to observe that the ActionF data type is itself indexed. We will adapt FreeIx to build an indexed monad using the free monoid, lists. The Free constructor for FreeIx will need to capture a witness to the finiteness of one of its two indexes for use in proofs. We will use a system due to András Kovács for writing proofs about appending type level lists to make proofs of both associativity and the right identity. We will describe indexed monads in the same manner as Oleg Grenrus. We will use the RebindbableSyntax extension to write expressions for an IxMonad using the ordinary do notation.

实现这一点需要大量的步骤。首先，我们需要观察ActionF数据类型本身是被索引的。我们将使用FreeIx来构建一个索引的monad，使用free monoid，列表。FreeIx的免费构造函数将需要为其两个索引之一的finiteness捕获一个证据，以便在证明中使用。我们将使用一个由Andras Kovacs编写的系统来编写关于附加类型级别列表的证明，以证明结合性和正确的标识。我们将用与Oleg Grenrus相同的方式描述索引的monads。我们将使用RebindbableSyntax扩展来使用普通的do符号来为IxMonad编写表达式。

Prologue

In addition to all of the extensions your example already requires and RebindbableSyntax which was mentioned above we will also need UndecidableInstances for the trivial purpose of reusing a type family definition.

除了您的示例已经需要的所有扩展，以及前面提到的RebindbableSyntax，我们还需要一些不可解的实例来重用一个类型的家庭定义。

{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RebindableSyntax #-}

We will be using the :~: GADT from Data.Type.Equality to manipulate type equality.

我们将使用:~:来自Data.Type的GADT。平等操纵类型平等。

import Data.Type.Equality
import Data.Proxy

Because we will be rebinding the Monad syntax, we'll hide all of Monad from the Prelude import. The RebindableSyntax extension uses for do notation whatever functions >>=, >>, and fail are in scope.

因为我们将重新绑定Monad语法，所以我们将把所有Monad隐藏起来。RebindableSyntax扩展用于做任何函数>>=，>>，以及失败的范围。

import Prelude hiding (Monad, (>>=), (>>), fail, return)

We also have a few bits of new general-purpose library code. I have given the HList an infix constructor, :::.

我们还有一些新的通用库代码。我已经给了HList一个infix构造函数::。

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

infixr 5 :::

I have renamed the Append type family ++ to mirror the ++ operator on lists.

我已经将Append类型的family ++重命名为在列表中镜像++运算符。

type family (++) (a :: [k]) (b :: [k]) :: [k] where
  '[]      ++ l  = l
  (e ': l) ++ l' = e ': l ++ l'

It's useful to talk about constraints of the form forall i. Functor (f i). These don't exist in Haskell outside GADTs that capture constraints like the Dict GADT in constraints. For our purposes, it will be sufficient to define a version of Functor with an extra ignored argument.

对于所有i. Functor (f i)的形式的约束是很有用的。在Haskell中，这些不存在于捕获约束的Haskell中，就像限制条件下的命令GADT一样。出于我们的目的，它将足以定义一个具有额外被忽略参数的函数的版本。

class Functor1 (f :: k -> * -> *) where
    fmap1 :: (a -> b) -> f i a -> f i b

Indexed ActionF

The ActionF Functor was missing something, it had no way to capture type level information about the requirements of the methods. We'll add an additional index type i to capture this. Input requires a single type, '[a], while Output requires no types, '[]. We are going to call this new type parameter the index of the functor.

ActionF函子丢失了一些东西，它无法捕获关于方法要求的类型级别信息。我们将添加一个额外的索引类型，以捕获这个。输入需要一个类型，'[a]，而输出不需要类型，'[]。我们将把这个新的类型参数命名为functor的索引。

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

We'll write Functor and Functor1 instances for ActionF.

我们将为ActionF编写Functor和Functor1实例。

instance Functor (ActionF i) where
  fmap f (Input c) = Input (fmap f c)
  fmap f (Output s n) = Output s (f n)

instance Functor1 ActionF where
  fmap1 f = fmap f

FreeIx Reconstructed

We are going to make two changes to FreeIx. We will change how the indexes are constructed. The Free constructor will refer to the index from the underlying functor, and produce a FreeIx with an index that's the free monoidal sum (++) of the index from the underlying functor and the index from the wrapped FreeIx. We will also require that Free captures a witness to a proof that the index of the underlying functor is finite.

我们要对FreeIx做两个改变。我们将改变索引的构造方式。*构造函数将引用来自底层函数的索引，并生成一个带有索引的FreeIx，该索引是从底层的函子和被包装的FreeIx的索引中得到的*的monoid sum(++)。我们还将要求免费获取一个证据，证明基础函子的索引是有限的。

data FreeIx f (i :: [k]) a where
  Return :: a -> FreeIx f '[] a
  Free :: (WitnessList i) => f i (FreeIx f j a) -> FreeIx f (i ++ j) a

We can define Functor and Functor1 instances for FreeIx.

我们可以为FreeIx定义Functor和Functor1实例。

instance (Functor1 f) => Functor (FreeIx f i) where
  fmap f (Return a) = Return (f a)
  fmap f (Free x) = Free (fmap1 (fmap f) x)

instance (Functor1 f) => Functor1 (FreeIx f) where
  fmap1 f = fmap f

If we want to use FreeIx with an ordinary, unindexed functor, we can lift those values to an unconstrained indexed functor, IxIdentityT. This isn't needed for this answer.

如果我们想用一个普通的、未被索引的函数来使用FreeIx，我们可以将这些值提升到一个不受约束的索引函子，IxIdentityT。这个答案是不需要的。

data IxIdentityT f i a = IxIdentityT {runIxIdentityT :: f a}

instance Functor f => Functor (IxIdentityT f i) where
    fmap f = IxIdentityT . fmap f . runIxIdentityT

instance Functor f => Functor1 (IxIdentityT f) where
    fmap1 f = fmap f

Proofs

We will need to prove two properties about appending type level lists. In order to write liftF we will need to prove the right identity xs ++ '[] ~ xs. We'll call this proof appRightId for append right identity. In order to write bind we will need to prove associativity xs ++ (yz ++ zs) ~ (xs ++ ys) ++ zs, which we will call appAssoc.

我们需要证明附加类型级别列表的两个属性。为了编写liftF，我们需要证明正确的身份xs ++ '[] ~ xs。我们称这个证明为appRightId，用于append right identity。为了编写bind，我们需要证明结合性xs ++ (yz + zs) ~ (xs ++ ys) + zs，我们将调用appAssoc。

The proofs are written in terms of a successor list which is essentially a list of proxies, one for each type type SList xs ~ HFMap Proxy (HList xs).

这些证明是用一个后续列表来写的，它实际上是一个代理列表，每个类型的列表都是一个列表，每个类型都是HFMap代理(HList xs)。

data SList (i :: [k]) where
  SNil :: SList '[]
  SSucc :: SList t -> SList (h ': t)

The following proof of associativity along with the method of writing this proof are due to András Kovács. By only using SList for the type list of xs we deconstruct and using Proxys for the other type lists, we can delay (possibly indefinitely) needing WitnessList instances for ys and zs.

下面的证据证明了结合性和写这个证明的方法是由于Andras Kovacs。通过使用xs的类型列表的列表来解构和使用其他类型列表的代理，我们可以延迟(可能是无限的)对ys和zs的观察列表实例。

appAssoc ::
  SList xs -> Proxy ys -> Proxy zs ->
  (xs ++ (ys ++ zs)) :~: ((xs ++ ys) ++ zs)
appAssoc SNil ys zs = Refl
appAssoc (SSucc xs) ys zs =
  case appAssoc xs ys zs of Refl -> Refl

Refl, the constructor for :~:, can only be constructed when the compiler is in possession of a proof that the two types are equal. Pattern matching on Refl introduces the proof of type equality into the current scope.

Refl:只有当编译器拥有这两种类型相等的证明时才能构造它。在Refl上的模式匹配将类型相等的证明引入当前范围。

We can prove the right identity in a similar fashion

我们可以用同样的方式证明正确的身份。

appRightId :: SList xs -> xs :~: (xs ++ '[])
appRightId SNil = Refl
appRightId (SSucc xs) = case appRightId xs of Refl -> Refl

To use these proofs we construct witness lists for the the class of finite type lists.

为了使用这些证明，我们为有限类型列表的类构造了目击者列表。

class WitnessList (xs :: [k]) where
  witness :: SList xs

instance WitnessList '[] where
  witness = SNil

instance WitnessList xs => WitnessList (x ': xs) where
  witness = SSucc witness

Lifting

Equipped with appRightId we can define lifting values from the underlying functor into FreeIx.

配置了appRightId，我们可以定义从底层的函数到FreeIx的提升值。

liftF :: forall f i a . (WitnessList i, Functor1 f) => f i a -> FreeIx f i a
liftF = case appRightId (witness :: SList i) of Refl -> Free . fmap1 Return

The explicit forall is for ScopedTypeVariables. The witness to the finiteness of the index, WitnessList i, is required by both the Free constructor and appRightId. The proof of appRightId is used to convince the compiler that the FreeIx f (i ++ '[]) a constructed is of the same type as FreeIx f i a. That '[] came from the Return that was wrapped in the underlying functor.

显式的forall为ScopedTypeVariables。在*构造函数和appRightId的要求下，证明了索引的有限性，即证人列表i。使用appRightId的证明可以使编译器确信，所构建的FreeIx f (i ++ '[])与FreeIx f i a所构建的类型相同，即[]来自于包在底层函子中的返回。

Our two commands, input and output, are written in terms of liftF.

我们的两个命令，输入和输出，都是用liftF来写的。

type Action i a = FreeIx ActionF i a

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

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

IxMonad and Binding

To use RebindableSyntax we'll define an IxMonad class with the same function names (>>=), (>>), and fail as Monad but different types. This class is described in Oleg Grenrus's answer.

要使用RebindableSyntax，我们将定义一个具有相同函数名称的IxMonad类(>>=)，(>>)，并作为Monad而失败，但类型不同。这门课是用奥列格·格里罗斯的答案来描述的。

class Functor1 m => IxMonad (m :: k -> * -> *) where
    type Unit :: k
    type Plus (i :: k) (j :: k) :: k

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

    (>>) :: m i a -> m j b -> m (Plus i j) b
    a >> b = a >>= const b

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

Implementing bind for FreeIx requires the proof of associativity, appAssoc. The only WitnessList instance in scope, WitnessList i, is the one captured by the deconstructed Free constructor. Once again, the explicit forall is for ScopedTypeVariables.

实现对FreeIx的绑定需要结合性的证明，appAssoc。在范围内唯一的证人列表实例，证人列表i，是被解构的*构造函数所捕获的。再一次，显式的forall是针对ScopedTypeVariables。

bind :: forall f i j a b. (Functor1 f) => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (i ++ j) b
bind (Return a) f = f a
bind (Free (x :: f i1 (FreeIx f j1 a))) f =
    case appAssoc (witness :: SList i1) (Proxy :: Proxy j1) (Proxy :: Proxy j)
    of Refl -> Free (fmap1 (`bind` f) x)

bind is the only interesting part of the IxMonad instance for FreeIx.

绑定是FreeIx的IxMonad实例中唯一有趣的部分。

instance (Functor1 f) => IxMonad (FreeIx f) where
    type Unit = '[]
    type Plus i j = i ++ j

    return = Return
    (>>=) = bind

We're done

All of the hard part is done. We can write a simple interpreter for Action xs () in the most straight forward fashion. The only trick required is to avoid pattern matching on the HList constructor ::: until after the type list i is known to be non-empty because we already matched on Input.

所有困难的部分都完成了。我们可以用最直接的方式为动作xs()编写一个简单的解释器。唯一需要的技巧是在HList构造函数上避免模式匹配:::直到类型列表之后，我才知道它是非空的，因为我们已经在输入上匹配了。

eval :: HList i -> Action i () -> [String]
eval inputs action = 
    case action of 
        Return () -> []
        Free (Input f) -> 
            case inputs of
                (x ::: xs) -> eval xs (f x)
        Free (Output s next) -> s : eval inputs next

If you are curious about the inferred type of addTwo

如果你对add2的推断类型感到好奇。

addTwo = do
  (x :: Int) <- input
  (y :: Int) <- input 
  output $ show (x + y)

it is

它是

> :t addTwo
addTwo :: FreeIx ActionF '[Int, Int] ()

#2

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):

到目前为止，我们使用的是由monoid索引的monads，但是在这里，我依赖于另一种流行的关于索引monad的概念，它具有类型状态转换(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.

我认为这两种方法是等价的(至少在理论上是这样的)，因为我们得到了Hoare monad，它是通过与自同态的monoid进行索引的，而且我们还可以通过CPS在状态转换中编码monoid append的方式来进行反向操作。在实践中，Haskell的类型级和kind级语言相当弱，因此在两个表示之间来回移动不是一个选项。

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:

但是，对于>>=:它意味着我们必须以自顶向下的顺序来计算typestate，即，它强制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:

所以,如果我们有一个免费的经验表达式,那么我们首先从我到j exp的构造函数后,然后从j k通过检查subexperssions exp。这意味着,如果我们试图积累输入类型列表中,我们最终逆转列表:

-- 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.

如果我们将类型添加到列表的末尾，那么顺序将是正确的。但是在Haskell(尤其是做eval工作)中工作需要大量的证明，如果这是可能的话。

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.

让我们以自底向上的方式来计算typestate。它做了各种计算，我们根据语法树建立了一些数据结构更加自然，特别是它使我们的工作变得非常简单。

{-# 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.

为了让用户不那么容易混淆，我引入了与friendlier索引方案相同的类型同义词:Action' xs rest a意味着该操作从xs中读取，然后可能是包含rest读取的操作。Action是与线程问题中出现的一个同义词等价的类型。

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:

我们可以用这种方法实现各种dsl。相反的输入顺序让它有点旋转，但是我们可以做通常的索引的单子。这里是索引状态monad，例如:

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.

现在，我认为这种方法比使用monoid进行索引更实用，因为Haskell没有类或一级类功能，这将使monoid方法变得容易接受。有一个VerifiedMonoid类很好，比如Idris或Agda，除了通常的方法外，还包括正确性证明。这样，我们就可以写一个FreeIx，它在索引monoid的选择上是通用的，而不局限于提升列表或其他东西。

#3

If you're willing to sacrifice the implicit ordering and use explicit accessors instead, your Action '[Int, Int] could be implemented using ReaderT (HList '[Int, Int]). If you use an existing library like vinyl that provides lenses, you could write something like this:

如果您愿意牺牲隐式排序并使用显式访问器，则可以使用ReaderT (HList '[Int, Int])来实现您的操作[Int, Int]。如果你使用像乙烯基这样的现有图书馆来提供镜头，你可以这样写:

-- Implemented with pseudo-vinyl
-- X and Y are Int fields, with accessors xField and yField
addTwo :: ReaderT (PlainRec '[X, Y]) Output ()
addTwo = do
  x <- view (rGet xField)
  y <- view (rGet yField)
  lift . output $ show (x + y) -- output :: String -> Output ()

Type safety is enforced by constraint propagation: rGet xField introduces a requirement that X be a member of the record.

类型安全由约束传播强制执行:rGet xField引入了一个要求，即X是记录的成员。

For a simpler illustration without the type-level machinery, compare:

对于一个更简单的例子，没有类型级别的机器，比较:

addTwo :: ReaderT (Int, Int) IO ()
addTwo = do
  x <- view _1
  y <- view _2
  lift . putStrLn $ show (x + y)

We lose the ordering property, which is significant loss, particularly if the ordering is meaningful, e.g. represents the order of user interaction.

我们丢失了排序属性，这是一个重要的损失，特别是如果排序是有意义的，例如表示用户交互的顺序。

Furthermore, we now have to use runReaderT (~ eval). We can't, say, interleave user input with output.

此外，我们现在必须使用runReaderT (~ eval)。我们不能将用户输入与输出连接起来。

#4

Shortly about indexed monads: They are monads indexed by monoids. For comparison default monad:

关于索引的monads:它们是由monoids索引的monads。默认的单子比较:

class Monad m where
  return :: a -> m a
  bind :: m a -> (a -> m b) -> m b
  -- or `bind` alternatives:
  fmap :: (a -> b) -> m a -> m b
  join :: m (m a) -> m a

A monoid is a type equiped with mempty - identity element, and (<>) :: a -> a -> a binary associative operation. Raised to type-level we could have Unit type, and Plus associative binary type operation. Note, a list is a free monoid on value level, and HList is on a type level.

monoid是一个带有mempty - identity元素的类型，并且(<>)::A -> A ->一个二元联合操作。提高到类型级别，我们可以有单元类型，加上关联式二进制类型操作。注意，列表是一个值级别上的*monoid，而HList在类型级别上。

Now we can define indexed monoid class:

现在我们可以定义index monoid类:

class IxMonad m where
  type Unit
  type Plus i j

  return :: a -> m Unit a
  bind :: m i a -> (a -> m j b) -> m (Plus i j) b
  --
  fmap :: (a -> b) -> m i a -> m i b
  join :: m i (m j a) -> m (Plus i j) a

You can state monad laws for indexed version. You'll notice that for indexes to align, they must obey monoid laws.

您可以为索引版本制定monad法律。您会注意到，为了使索引对齐，它们必须遵守monoid规则。

---

With free monad you want equip a Functor with return and join operations. With slightly altererd your definition works:

有了免费的monad，你想要装备一个有返回和连接操作的功能。你的定义略有改动:

data FreeIx f i a where
  Return :: a -> FreeIx f '[] a -- monoid laws imply we should have `[] as index here!
  Free :: f (FreeIx f k a) -> FreeIx f k a

bind :: Functor f => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (Append i j) b
bind (Return a) f = f a
bind (Free x) f   = Free (fmap (flip bind f) x)

---

I have to admit, I'm not 100% sure how Free constructor indexes are justified, but they seem to work. If we consider the function wrap :: f (m a) -> m a of MonadFree class with a law:

我必须承认，我并不是100%肯定*构造函数索引是有道理的，但它们似乎起作用了。如果我们考虑函数wrap:: f (m a) -> m a，有一条法律:

wrap (fmap f x) ≡ wrap (fmap return x) >>= f

and a comment about Free in free package

以及一个免费的评论。

In practice, you can just view a Free f a as many layers of f wrapped around values of type a, where (>>=) performs substitution and grafts new layers of f in for each of the free variables.

在实践中，您可以只看到一个*的f a，它包含了a类型的多个层，其中(>>=)在每个*变量中执行替换和移植新的f层。

then the idea is that wrapping values doesn't affect the index.

其思想是包装值不会影响索引。

---

Yet, you want to lift any f value to an arbitrary indexed monadic value. This is a very reasonable requirement. But the only valid definition forces lifted value to have '[] - Unit or mempty index:

但是，您想要将任何f值提升到任意索引的一元值。这是一个非常合理的要求。但是，唯一有效的定义强制提升了“[]-单元或mempty索引:

liftF :: Functor f => f a -> FreeIx f '[] a
liftF = Free . fmap Return

If you try to change Return definition to :: a -> FreeIx f k a (k, not [] -- pure value could have an arbitrary index), then bind definition won't type check.

如果您尝试将返回定义更改为::a -> freeixf k a (k, not[]——纯值可以有一个任意的索引)，那么绑定定义就不会进行类型检查。

---

I'm not sure if you can make the free indexed monad work with small corrections only. One idea is to lift an arbitrary monad into an indexed monad:

我不确定你是否能让免费索引的monad只做小修改。一种方法是将任意的monad移到一个索引的monad中:

data FreeIx m i a where
  FreeIx :: m a -> FreeIx m k a

liftF :: Proxy i -> f a -> FreeIx f i a
liftF _ = FreeIx

returnIx :: Monad m => a -> FreeIx m i a
returnIx = FreeIx . return

bind :: Monad m => FreeIx m i a -> (a -> FreeIx m j b) -> FreeIx m (Append i j) b
bind (FreeIx x) f = FreeIx $ x >>= (\x' -> case f x' of
                                             FreeIx y -> y)

This approach feels a bit like cheating, as we could always re-index the value.

这种方法有点像作弊，因为我们总是可以重新索引值。

---

Another approach is to remind Functor it's a indexed functor, or start right away with indexed functor as in Cirdec's answer.

另一种方法是提醒函子，它是一个被索引的函子，或从索引函子开始，就像在Cirdec的答案中一样。

#5

EDIT: I have posted a more general alternative answer. I leave this answer here for now since it may be an useful example for constructing the target monad by hand.

编辑:我已经发布了一个更通用的替代答案。我现在把这个答案留在这里，因为它可能是一个用手构建目标单的有用的例子。

My solution does what OP asked for (though it involves manual monad instance writing, so there's room for refinement certainly).

我的解决方案做了OP所要求的(尽管它涉及手动的monad实例的编写，所以肯定有改进的空间)。

The effect-monad package (which OP mentioned) already contains an effect that handles reading from a HList. It's called ReadOnceReader. However, we also need a Writer effect for Output, and it seems to me that the library doesn't let us combine these two.

效果-monad包(上面提到的OP)已经包含一个处理从HList读取的效果。它叫做ReadOnceReader。然而，我们也需要一个输出的作者效应，在我看来，图书馆不让我们把这两者结合起来。

We can still take the idea of ReadOnceReader and manually write an AST for the desired language. The AST should be an indexed monad, of course. It would be neat if we could also do this through an indexed free monad or operational monad. I haven't had success with free monads thus far. I might update my answer after I looked at operational monads.

我们仍然可以采用ReadOnceReader的思想，并手动为所需的语言编写AST。当然，AST应该是一个有索引的单子。如果我们也可以通过一个索引的免费monad或操作monad来实现这一点，那就太棒了。到目前为止，我还没有获得过免费的单子。我可能会更新我的答案，因为我看了运营的单子。

Preliminaries:

预赛:

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

import Prelude hiding (Monad(..))

data HList (xs :: [*]) where
  Nil  :: HList '[]
  (:>) :: x -> HList xs -> HList (x ': xs)
infixr 5 :>                     

type family (++) (xs :: [*]) (ys :: [*]) where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

Indexed monads must provide a way to combine (Plus) indices, with identity (Unit). In short, indices should be monoids.

索引的monads必须提供一种将(+)索引与标识(单位)相结合的方法。简而言之，指数应该是单一的。

class IxMonad (m :: k -> * -> *) where
  type Unit m :: k
  type Plus m (i :: k) (j :: k) :: k
  return :: a -> m (Unit m) a
  (>>=)  :: m i a -> (a -> m j b) -> m (Plus m i j) b
  fail   :: m i a

The type of Input is of interest here: we prepend the input type to the resulting index of the next computation:

这里输入的类型是感兴趣的:我们将输入类型预先输入到下一个计算的结果索引中:

data Action i a where
  Return :: a -> Action '[] a
  Input  :: (x -> Action xs a) -> Action (x ': xs) a
  Output :: String -> Action i a -> Action i a
deriving instance Functor (Action i)

The IxMonad instance and the smart constructors are fully standard, and the eval function is also implemented straightforwardly.

IxMonad实例和智能构造函数都是完全标准的，eval函数也直接实现。

instance IxMonad Action where
  type Unit Action = '[]
  type Plus Action i j = i ++ j
  return = Return
  Return a     >>= f = f a
  Input k      >>= f = Input ((>>= f) . k)
  Output s nxt >>= f = Output s (nxt >>= f)
  fail = undefined

input :: Action '[a] a
input = Input Return

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

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

Now everything works as desired:

现在一切都如愿以偿了:

concat' :: Action '[String, String] ()
concat' = do
  (x :: String) <- input
  (y :: String) <- input 
  output $ x ++ " " ++ y

main = print $ eval concat' ("a" :> "b" :> Nil)
-- prints ["a b"]

#6

I have a working implementation of an indexed free monad on github from a few years back:

几年前，我在github上做了一个索引免费monad的工作实现:

https://github.com/ekmett/indexed/blob/master/src/Indexed/Monad/Free.hs

https://github.com/ekmett/indexed/blob/master/src/Indexed/Monad/Free.hs

It uses the form of indexed monad proposed by Conor McBride in Kleisli Arrows of Outrageous Fortune, and that can be adapted to provide a 2-index free monad in the style of Bob Atkey in the manner described in the paper as well.

它使用了Conor McBride在Kleisli箭矢中提出的索引monad的形式，并且可以根据文章中所描述的方式，以Bob Atkey的方式提供一个2索引*的monad。