我怎样才能在 Haskell / Idris 中拥有一个受约束的有限状态机？
How can I have a constrained Finite State Machine in Haskell / Idris?
编辑： 用户@apocalisp 和@BenjaminHodgson 在下方留下了很棒的答案，跳过阅读大部分问题并跳转到他们的答案。
问题的 TLDR：我怎样才能从第一张图片（其中 FSM 表示组合爆炸）转到第二张图片（您只需要访问所有图片）他们在继续之前。
我想构建一个 有限状态机（确实在 Haskell 中，但我首先尝试 Idris 看看它是否可以指导我的 Haskell) 在达到最终状态之前必须访问一些中间状态。如果我可以在某些状态上使用谓词任意约束 FSM，那就太好了。
在下图中，有一个Initial状态，3个中间状态A, B, C，和一个Final状态。如果我没记错的话，在 "normal" FSM 中，您将始终需要 n! 临时状态来表示可能路径的每个组合。
这是不可取的。
相反，使用 Type Families，也许 Dependent types，我认为应该有一种状态是随身携带，只有当它通过某些谓词时，你才会被允许旅行到最终状态。 （这是否使 下推自动机 而不是 FSM？）
我目前的代码（idris），以此类推，就是添加配料做沙拉，顺序无所谓，但都是需要做的在：
data SaladState = Initial | AddingIngredients | ReadyToEat
record SaladBowl where
constructor MkSaladBowl
lettuce, tomato, cucumber : Bool
data HasIngredient : (ingredient : SaladBowl -> Bool) -> (bowl : SaladBowl ** ingredient bowl = True) -> Type where
Bowl : HasIngredient ingredient bowl
data HasIngredients : (ingredients : List (SaladBowl -> Bool))
-> (bowl : SaladBowl ** (foldl (&&) True (map (\i => i bowl) ingredients) = True))
-> Type where
Bowlx : HasIngredients ingredients bowl
data SaladAction : (ty : Type) -> SaladState -> (ty -> SaladState) -> Type where
GetBowl : SaladAction SaladBowl Initial (const Initial)
AddLettuce : SaladBowl -> SaladAction (bowl ** HasIngredient lettuce bowl) st (const AddingIngredients)
AddTomato : SaladBowl -> SaladAction (bowl ** HasIngredient tomato bowl) st (const AddingIngredients)
AddCucumber : SaladBowl -> SaladAction (bowl ** HasIngredient cucumber bowl) st (const AddingIngredients)
MixItUp : SaladBowl -> SaladAction (bowl ** (HasIngredients [lettuce, tomato, cucumber] bowl)) AddingIngredients (const ReadyToEat)
Pure : (res : ty) -> SaladAction ty (state_fn res) state_fn
(>>=) : SaladAction a state1 state2_fn
-> ((res : a) -> SaladAction b (state2_fn res) state3_fn)
-> SaladAction b state1 state3_fn
emptyBowl : SaladBowl
emptyBowl = MkSaladBowl False False False
prepSalad1 : SaladAction SaladBowl Initial (const ReadyToEat)
prepSalad1 = do
(b1 ** _) <- AddTomato emptyBowl
(b2 ** _) <- AddLettuce b1
(b3 ** _) <- AddCucumber b2
MixItUp b3
以及编译器应该出错的反例程序：
BAD : SaladAction SaladBowl Initial (const ReadyToEat)
BAD = do
(b1 ** _) <- AddTomato emptyBowl
(b2 ** _) <- AddTomato emptyBowl
(b3 ** _) <- AddLettuce b2
(b4 ** _) <- AddCucumber b3
MixItUp b4
BAD' : SaladAction SaladBowl Initial (const ReadyToEat)
BAD' = do
(b1 ** _) <- AddTomato emptyBowl
MixItUp b1
我最终希望 "ingredients" 是 Sums 而不是 Bools (data Lettuce = Romaine | Iceberg | Butterhead)，以及更健壮的语义，我可以在其中说 "you must first add lettuce, or spinach, but not both".
真的，我感到非常迷茫，我想我上面的代码完全走错了方向......我如何构建这个 FSM（PDA？）来排除不良程序？我特别想为它使用 Haskell，也许使用 Indexed Monads?
索引状态 monad 正是这样做的。
常规 State s monad 为状态机（具体地说是 Mealy 机器）建模，其状态字母表为 s 类型。这种数据类型实际上只是一个函数：
newtype State s a = State { run :: s -> (a, s) }
a -> State s b 类型的函数是一个输入字母 a 和输出字母 b 的机器。但它实际上只是 (a, s) -> (b, s).
类型的函数
将一台机器的输入类型和另一台机器的输出类型排列起来，我们可以组成两台机器：
(>>=) :: State s a -> (a -> State s b) -> State s b
m >>= f = State (\s1 -> let (a, s2) = run m s1 in run (f a) s2)
换句话说，State s是一个monad。
但有时（如您的情况），我们需要改变中间状态的类型。这就是索引状态 monad 的用武之地。它有 两个 状态字母表。 IxState i j a 对开始状态必须为 i 且结束状态为 j:
的机器建模
newtype IxState i j a = IxState { run :: i -> (a, j) }
常规 State s monad 等同于 IxState s s。我们可以像 State 一样轻松地编写 IxState。实现与之前相同，但类型签名更通用：
(>>>=) :: IxState i j a -> (a -> IxState j k b) -> IxState i k b
m >>>= f = IxState (\s1 -> let (a, s2) = run m s1 in run (f a) s2)
IxState 不完全是一个 monad，而是一个 indexed monad.
我们现在只需要一种指定状态类型约束的方法。对于沙拉示例，我们想要这样的东西：
mix :: IxState (Salad r) Ready ()
这是一台机器，它的输入状态是一些不完整的Salad，由原料r组成，它的输出状态是Ready，表示我们的沙拉可以吃了。
使用类型级列表，我们可以这样说：
data Salad xs = Salad
data Ready = Ready
data Lettuce
data Cucumber
data Tomato
空沙拉的成分列表为空。
emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad
我们可以在任何沙拉中加入生菜：
addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad
我们可以对番茄和黄瓜重复同样的操作。
现在 mix 的类型只需要是：
mix :: IxState (Salad '[Lettuce, Cucumber, Tomato]) Ready ()
mix = const Ready
如果我们尝试按顺序混合任何未添加 Lettuce、Cucumber 和 Tomato 的沙拉，我们将收到类型错误。例如。这将是一个类型错误：
emptyBowl >>>= \_ -> addLettuce >>>= \_ -> mix
但理想情况下，我们希望能够按任何顺序添加成分。因此，我们需要对我们的类型级别列表进行限制，要求提供证据表明沙拉中某处有特定成分：
class Elem xs x
instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x
Elem xs x 现在是类型 x 在类型级别列表 xs 中的证据。第一个实例（基本情况）说 x 显然是 x ': xs 的一个元素。第二个实例表示如果类型 x 是 xs 的元素，那么它对于任何类型 y 也是 y ': xs 的元素。 OVERLAPS 是确保 Haskell 知道首先检查基本情况所必需的。
这是完整的清单：
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Indexed
import Control.Monad.Indexed.State
data Lettuce
data Tomato
data Cucumber
data Ready = Ready
class Elem xs x
instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x
data Salad xs = Salad
emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad
addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad
addTomato :: IxState (Salad r) (Salad (Tomato ': r)) ()
addTomato = iput Salad
addCucumber :: IxState (Salad r) (Salad (Cucumber ': r)) ()
addCucumber = iput Salad
mix :: (Elem r Lettuce, Elem r Tomato, Elem r Cucumber)
=> IxState (Salad r) Ready ()
mix = imodify mix'
where mix' = const Ready
x >>> y = x >>>= const y
-- Compiles
test = emptyBowl >>> addLettuce >>> addTomato >>> addCucumber >>> mix
-- Fails with a compile-time type error
fail = emptyBowl >>> addTomato >>> mix
你的问题有点含糊，但我读作 "how can I incrementally build a heterogeneous 'context' and create a record once I have values of the correct types in scope?" 下面是我给这只猫剥皮的方法：与其将输入和输出类型通过一些 monadic 上下文线程化，不如让我们使用普通函数.如果您想使用聪明的类型级机制，您可以将它与您传递的值一起使用，而不是围绕特定的计算概念构建您的程序。
够胡扯了。我将把异构上下文表示为嵌套元组。我将使用单位 (()) 来表示一个空上下文，并且我将通过将上下文嵌套到新元组的左侧元素中来向上下文添加类型。因此，包含 Int、Bool 和 Char 的上下文看起来像这样：
type IntBoolChar = ((((), Int), Bool), Char)
希望您能看到如何逐步向沙拉碗中添加配料：
-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce)
addLettuce = (, Romaine)
addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)
addCheese :: a -> (a, Cheese)
addCheese = (, Feta)
addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
-- yes, i know you also need tomatoes and onions for a Greek salad. i'm trying to keep the example short
addGreekSaladIngredients = addCheese . addOlives . addLettuce
这不是高级魔法。它适用于任何带有元组的语言。我什至在 C# 中围绕这个想法设计了真实世界的 API，以部分弥补 C# 在 Haskell 中使用 Applicative 语法时缺乏柯里化的不足。 Here's an example from my parser combinator library: starting with an empty permutation parser, you Add a number of atomic parsers of different types, and then Build 一个以顺序不敏感的方式运行这些解析器的解析器，返回它们结果的嵌套元组，然后您可以手动将其展平。
问题的另一半是关于将这种上下文的值转换为记录。
data Salad = Salad {
_lettuce :: Lettuce,
_olive :: Olive,
_cheese :: Cheese
}
您可以使用以下简单的 class:
以不区分顺序的方式将嵌套元组一般映射到记录上
class Has a s where
has :: Lens' s a
-- this kind of function can be written generically using TH or Generics
toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x^.has) (x^.has) (x^.has)
（这是 the HasX classes that lens generates with Template Haskell 的直接概括。）
唯一需要某种类型技巧的部分是为嵌套元组自动实例化 Has。我们需要区分两种情况：我们要查找的类型的项要么位于一对的右侧，要么位于该对左侧的嵌套元组内的某个位置。问题在于，在一般情况下，这两种情况在阐述者看来是一样的：实例解析是通过一个头脑简单的句法类型匹配过程发生的；不检查类型相等性并且不会发生回溯。
结果是我们需要The Advanced Overlap Trick。简而言之，该技巧使用封闭类型族来根据类型相等性分派类型 class。我们在两个备选方案之间进行选择，因此这是可接受类型级布尔值的少数情况之一。
type family Here a as where
Here a (_, a) = True
Here a (_, b) = False
class Has' (here :: Bool) a s where
has' :: Proxy here -> Lens' s a
instance Has' True a (as, a) where
has' _ = _2
instance Has a as => Has' False a (as, b) where
has' _ = _1.has
instance Has' (Here a (as, b)) a (as, b) => Has a (as, b) where
has = has' (Proxy :: Proxy (Here a (as, b)))
本程序将在第一个匹配类型处停止搜索。如果您的沙拉中需要两种不同类型的生菜，则必须将一种用 newtype 包裹起来。在实践中，当您将此缺点与重叠实例的复杂性结合起来时，我不相信 Has 抽象会带来好处。我只是手动压平元组：
toSalad :: (((a, Lettuce), Olive), Cheese) -> Salad
toSalad (((_, l), o), c) = Salad l o c
虽然你确实失去了顺序不敏感。
这是一个用法示例：
greekSalad = toSalad $ addGreekSaladIngredients ()
ghci> greekSalad
Salad {_lettuce = Romaine, _olive = Kalamata, _cheese = Feta} -- after deriving Show
这是完成的程序
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Lens hiding (has, has')
import Data.Proxy
data Lettuce = Romaine deriving (Show)
data Olive = Kalamata deriving (Show)
data Cheese = Feta deriving (Show)
data Salad = Salad {
_lettuce :: Lettuce,
_olive :: Olive,
_cheese :: Cheese
} deriving (Show)
-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce) -- <<< Tuple Sections
addLettuce = (, Romaine)
addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)
addCheese :: a -> (a, Cheese)
addCheese = (, Feta)
addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
addGreekSaladIngredients = addCheese . addOlives . addLettuce
class Has a s where
has :: Lens' s a
type family Here a as where
Here a (_, a) = True
Here a (_, b) = False
class Has' (here :: Bool) a s where
has' :: Proxy here -> Lens' s a
instance Has' True a (as, a) where
has' _ = _2
instance Has a as => Has' False a (as, b) where
has' _ = _1.has
instance Has' (Here a (as, b)) a (as, b) => Has a (as, b) where -- <<< Undecidable Instances
has = has' (Proxy :: Proxy (Here a (as, b)))
toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x ^. has) (x ^. has) (x ^. has)
greekSalad = toSalad $ addGreekSaladIngredients ()
-- nonSaladsError = toSalad $ (addCheese . addOlives) ()
编辑： 用户@apocalisp 和@BenjaminHodgson 在下方留下了很棒的答案，跳过阅读大部分问题并跳转到他们的答案。
问题的 TLDR：我怎样才能从第一张图片（其中 FSM 表示组合爆炸）转到第二张图片（您只需要访问所有图片）他们在继续之前。
我想构建一个 有限状态机（确实在 Haskell 中，但我首先尝试 Idris 看看它是否可以指导我的 Haskell) 在达到最终状态之前必须访问一些中间状态。如果我可以在某些状态上使用谓词任意约束 FSM，那就太好了。
在下图中，有一个Initial状态，3个中间状态A, B, C，和一个Final状态。如果我没记错的话，在 "normal" FSM 中，您将始终需要 n! 临时状态来表示可能路径的每个组合。
这是不可取的。
相反，使用 Type Families，也许 Dependent types，我认为应该有一种状态是随身携带，只有当它通过某些谓词时，你才会被允许旅行到最终状态。 （这是否使 下推自动机 而不是 FSM？）
我目前的代码（idris），以此类推，就是添加配料做沙拉，顺序无所谓，但都是需要做的在：
data SaladState = Initial | AddingIngredients | ReadyToEat
record SaladBowl where
constructor MkSaladBowl
lettuce, tomato, cucumber : Bool
data HasIngredient : (ingredient : SaladBowl -> Bool) -> (bowl : SaladBowl ** ingredient bowl = True) -> Type where
Bowl : HasIngredient ingredient bowl
data HasIngredients : (ingredients : List (SaladBowl -> Bool))
-> (bowl : SaladBowl ** (foldl (&&) True (map (\i => i bowl) ingredients) = True))
-> Type where
Bowlx : HasIngredients ingredients bowl
data SaladAction : (ty : Type) -> SaladState -> (ty -> SaladState) -> Type where
GetBowl : SaladAction SaladBowl Initial (const Initial)
AddLettuce : SaladBowl -> SaladAction (bowl ** HasIngredient lettuce bowl) st (const AddingIngredients)
AddTomato : SaladBowl -> SaladAction (bowl ** HasIngredient tomato bowl) st (const AddingIngredients)
AddCucumber : SaladBowl -> SaladAction (bowl ** HasIngredient cucumber bowl) st (const AddingIngredients)
MixItUp : SaladBowl -> SaladAction (bowl ** (HasIngredients [lettuce, tomato, cucumber] bowl)) AddingIngredients (const ReadyToEat)
Pure : (res : ty) -> SaladAction ty (state_fn res) state_fn
(>>=) : SaladAction a state1 state2_fn
-> ((res : a) -> SaladAction b (state2_fn res) state3_fn)
-> SaladAction b state1 state3_fn
emptyBowl : SaladBowl
emptyBowl = MkSaladBowl False False False
prepSalad1 : SaladAction SaladBowl Initial (const ReadyToEat)
prepSalad1 = do
(b1 ** _) <- AddTomato emptyBowl
(b2 ** _) <- AddLettuce b1
(b3 ** _) <- AddCucumber b2
MixItUp b3
以及编译器应该出错的反例程序：
BAD : SaladAction SaladBowl Initial (const ReadyToEat)
BAD = do
(b1 ** _) <- AddTomato emptyBowl
(b2 ** _) <- AddTomato emptyBowl
(b3 ** _) <- AddLettuce b2
(b4 ** _) <- AddCucumber b3
MixItUp b4
BAD' : SaladAction SaladBowl Initial (const ReadyToEat)
BAD' = do
(b1 ** _) <- AddTomato emptyBowl
MixItUp b1
我最终希望 "ingredients" 是 Sums 而不是 Bools (data Lettuce = Romaine | Iceberg | Butterhead)，以及更健壮的语义，我可以在其中说 "you must first add lettuce, or spinach, but not both".
真的，我感到非常迷茫，我想我上面的代码完全走错了方向......我如何构建这个 FSM（PDA？）来排除不良程序？我特别想为它使用 Haskell，也许使用 Indexed Monads?
索引状态 monad 正是这样做的。
常规 State s monad 为状态机（具体地说是 Mealy 机器）建模，其状态字母表为 s 类型。这种数据类型实际上只是一个函数：
newtype State s a = State { run :: s -> (a, s) }
a -> State s b 类型的函数是一个输入字母 a 和输出字母 b 的机器。但它实际上只是 (a, s) -> (b, s).
将一台机器的输入类型和另一台机器的输出类型排列起来，我们可以组成两台机器：
(>>=) :: State s a -> (a -> State s b) -> State s b
m >>= f = State (\s1 -> let (a, s2) = run m s1 in run (f a) s2)
换句话说，State s是一个monad。
但有时（如您的情况），我们需要改变中间状态的类型。这就是索引状态 monad 的用武之地。它有 两个 状态字母表。 IxState i j a 对开始状态必须为 i 且结束状态为 j:
newtype IxState i j a = IxState { run :: i -> (a, j) }
常规 State s monad 等同于 IxState s s。我们可以像 State 一样轻松地编写 IxState。实现与之前相同，但类型签名更通用：
(>>>=) :: IxState i j a -> (a -> IxState j k b) -> IxState i k b
m >>>= f = IxState (\s1 -> let (a, s2) = run m s1 in run (f a) s2)
IxState 不完全是一个 monad，而是一个 indexed monad.
我们现在只需要一种指定状态类型约束的方法。对于沙拉示例，我们想要这样的东西：
mix :: IxState (Salad r) Ready ()
这是一台机器，它的输入状态是一些不完整的Salad，由原料r组成，它的输出状态是Ready，表示我们的沙拉可以吃了。
使用类型级列表，我们可以这样说：
data Salad xs = Salad
data Ready = Ready
data Lettuce
data Cucumber
data Tomato
空沙拉的成分列表为空。
emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad
我们可以在任何沙拉中加入生菜：
addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad
我们可以对番茄和黄瓜重复同样的操作。
现在 mix 的类型只需要是：
mix :: IxState (Salad '[Lettuce, Cucumber, Tomato]) Ready ()
mix = const Ready
如果我们尝试按顺序混合任何未添加 Lettuce、Cucumber 和 Tomato 的沙拉，我们将收到类型错误。例如。这将是一个类型错误：
emptyBowl >>>= \_ -> addLettuce >>>= \_ -> mix
但理想情况下，我们希望能够按任何顺序添加成分。因此，我们需要对我们的类型级别列表进行限制，要求提供证据表明沙拉中某处有特定成分：
class Elem xs x
instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x
Elem xs x 现在是类型 x 在类型级别列表 xs 中的证据。第一个实例（基本情况）说 x 显然是 x ': xs 的一个元素。第二个实例表示如果类型 x 是 xs 的元素，那么它对于任何类型 y 也是 y ': xs 的元素。 OVERLAPS 是确保 Haskell 知道首先检查基本情况所必需的。
这是完整的清单：
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Indexed
import Control.Monad.Indexed.State
data Lettuce
data Tomato
data Cucumber
data Ready = Ready
class Elem xs x
instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x
data Salad xs = Salad
emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad
addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad
addTomato :: IxState (Salad r) (Salad (Tomato ': r)) ()
addTomato = iput Salad
addCucumber :: IxState (Salad r) (Salad (Cucumber ': r)) ()
addCucumber = iput Salad
mix :: (Elem r Lettuce, Elem r Tomato, Elem r Cucumber)
=> IxState (Salad r) Ready ()
mix = imodify mix'
where mix' = const Ready
x >>> y = x >>>= const y
-- Compiles
test = emptyBowl >>> addLettuce >>> addTomato >>> addCucumber >>> mix
-- Fails with a compile-time type error
fail = emptyBowl >>> addTomato >>> mix
你的问题有点含糊，但我读作 "how can I incrementally build a heterogeneous 'context' and create a record once I have values of the correct types in scope?" 下面是我给这只猫剥皮的方法：与其将输入和输出类型通过一些 monadic 上下文线程化，不如让我们使用普通函数.如果您想使用聪明的类型级机制，您可以将它与您传递的值一起使用，而不是围绕特定的计算概念构建您的程序。
够胡扯了。我将把异构上下文表示为嵌套元组。我将使用单位 (()) 来表示一个空上下文，并且我将通过将上下文嵌套到新元组的左侧元素中来向上下文添加类型。因此，包含 Int、Bool 和 Char 的上下文看起来像这样：
type IntBoolChar = ((((), Int), Bool), Char)
希望您能看到如何逐步向沙拉碗中添加配料：
-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce)
addLettuce = (, Romaine)
addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)
addCheese :: a -> (a, Cheese)
addCheese = (, Feta)
addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
-- yes, i know you also need tomatoes and onions for a Greek salad. i'm trying to keep the example short
addGreekSaladIngredients = addCheese . addOlives . addLettuce
这不是高级魔法。它适用于任何带有元组的语言。我什至在 C# 中围绕这个想法设计了真实世界的 API，以部分弥补 C# 在 Haskell 中使用 Applicative 语法时缺乏柯里化的不足。 Here's an example from my parser combinator library: starting with an empty permutation parser, you Add a number of atomic parsers of different types, and then Build 一个以顺序不敏感的方式运行这些解析器的解析器，返回它们结果的嵌套元组，然后您可以手动将其展平。
问题的另一半是关于将这种上下文的值转换为记录。
data Salad = Salad {
_lettuce :: Lettuce,
_olive :: Olive,
_cheese :: Cheese
}
您可以使用以下简单的 class:
以不区分顺序的方式将嵌套元组一般映射到记录上class Has a s where
has :: Lens' s a
-- this kind of function can be written generically using TH or Generics
toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x^.has) (x^.has) (x^.has)
（这是 the HasX classes that lens generates with Template Haskell 的直接概括。）
唯一需要某种类型技巧的部分是为嵌套元组自动实例化 Has。我们需要区分两种情况：我们要查找的类型的项要么位于一对的右侧，要么位于该对左侧的嵌套元组内的某个位置。问题在于，在一般情况下，这两种情况在阐述者看来是一样的：实例解析是通过一个头脑简单的句法类型匹配过程发生的；不检查类型相等性并且不会发生回溯。
结果是我们需要The Advanced Overlap Trick。简而言之，该技巧使用封闭类型族来根据类型相等性分派类型 class。我们在两个备选方案之间进行选择，因此这是可接受类型级布尔值的少数情况之一。
type family Here a as where
Here a (_, a) = True
Here a (_, b) = False
class Has' (here :: Bool) a s where
has' :: Proxy here -> Lens' s a
instance Has' True a (as, a) where
has' _ = _2
instance Has a as => Has' False a (as, b) where
has' _ = _1.has
instance Has' (Here a (as, b)) a (as, b) => Has a (as, b) where
has = has' (Proxy :: Proxy (Here a (as, b)))
本程序将在第一个匹配类型处停止搜索。如果您的沙拉中需要两种不同类型的生菜，则必须将一种用 newtype 包裹起来。在实践中，当您将此缺点与重叠实例的复杂性结合起来时，我不相信 Has 抽象会带来好处。我只是手动压平元组：
toSalad :: (((a, Lettuce), Olive), Cheese) -> Salad
toSalad (((_, l), o), c) = Salad l o c
虽然你确实失去了顺序不敏感。
这是一个用法示例：
greekSalad = toSalad $ addGreekSaladIngredients ()
ghci> greekSalad
Salad {_lettuce = Romaine, _olive = Kalamata, _cheese = Feta} -- after deriving Show
这是完成的程序
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Lens hiding (has, has')
import Data.Proxy
data Lettuce = Romaine deriving (Show)
data Olive = Kalamata deriving (Show)
data Cheese = Feta deriving (Show)
data Salad = Salad {
_lettuce :: Lettuce,
_olive :: Olive,
_cheese :: Cheese
} deriving (Show)
-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce) -- <<< Tuple Sections
addLettuce = (, Romaine)
addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)
addCheese :: a -> (a, Cheese)
addCheese = (, Feta)
addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
addGreekSaladIngredients = addCheese . addOlives . addLettuce
class Has a s where
has :: Lens' s a
type family Here a as where
Here a (_, a) = True
Here a (_, b) = False
class Has' (here :: Bool) a s where
has' :: Proxy here -> Lens' s a
instance Has' True a (as, a) where
has' _ = _2
instance Has a as => Has' False a (as, b) where
has' _ = _1.has
instance Has' (Here a (as, b)) a (as, b) => Has a (as, b) where -- <<< Undecidable Instances
has = has' (Proxy :: Proxy (Here a (as, b)))
toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x ^. has) (x ^. has) (x ^. has)
greekSalad = toSalad $ addGreekSaladIngredients ()
-- nonSaladsError = toSalad $ (addCheese . addOlives) ()