`Alternative` 中的模式匹配

Question

我有一个函数，该函数在其参数上进行模式匹配以在 StateT () Maybe () 中生成计算。当运行时，此计算可能会失败，在这种情况下，我希望当前模式匹配分支失败，可以这么说。

我非常怀疑是否可能有类似

的东西

compute :: Int -> StateT () Maybe Int
compute = return

f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f (Just n1) (Just n2) = do
  m <- compute (n1 + n2) 
  guard (m == 42)
f (Just n) _ = do
  m <- compute n
  guard (m == 42)
f _ (Just n) = do
  m <- compute n
  guard (m == 42)

按照我希望的方式运行：当第一次计算由于 guard 或 compute 中的某处失败时，我希望 f 尝试下一个模式。

显然上面的方法行不通，因为 StateT（任何其他 monad 可能）在扩展时涉及一个额外的参数，所以我可能不能将其表述为简单的模式保护。

下面是我想要的，但是很丑：

f' :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f' a b = asum (map (\f -> f a b) [f1, f2, f3])
  where
    f1 a b = do
      Just n1 <- pure a
      Just n2 <- pure b
      m <- compute (n1 + n2) 
      guard (m == 42)
    f2 a _ = do
      Just n <- pure a
      m <- compute n
      guard (m == 42)
    f3 _ b = do
      Just n <- pure b
      m <- compute n
      guard (m == 42)

对于 f，像 execStateT (f (Just 42) (Just 1)) () 这样的调用会失败，但是对于 f'，return Just () 会失败，因为它匹配 f2.

如何获得 f' 的行为，同时像 f 那样使用尽可能少的辅助定义进行优雅的模式匹配？还有其他更优雅的方式来表达这个吗？

完成运行可用示例：

#! /usr/bin/env stack
-- stack --resolver=lts-11.1 script

import Control.Monad.Trans.State
import Control.Applicative
import Control.Monad
import Data.Foldable

compute :: Int -> StateT () Maybe Int
compute = return

f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f (Just n1) (Just n2) = do
  m <- compute (n1 + n2) 
  guard (m == 42)
f (Just n) _ = do
  m <- compute n
  guard (m == 42)
f _ (Just n) = do
  m <- compute n
  guard (m == 42)

f' :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f' a b = asum (map (\f -> f a b) [f1, f2, f3])
  where
    f1 a b = do
      Just n1 <- pure a
      Just n2 <- pure b
      m <- compute (n1 + n2) 
      guard (m == 42)
    f2 a _ = do
      Just n <- pure a
      m <- compute n
      guard (m == 42)
    f3 _ b = do
      Just n <- pure b
      m <- compute n
      guard (m == 42)

main = do
  print $ execStateT (f (Just 42) (Just 1)) ()  -- Nothing
  print $ execStateT (f' (Just 42) (Just 1)) () -- Just (), because `f2` succeeded

编辑：到目前为止，我对这个问题得出了很多聪明的答案，谢谢！不幸的是，它们大多因过度拟合我给出的特定代码示例而受苦。实际上，我需要这样的东西来统一两个表达式（准确地说是 let 绑定），我想尽可能地尝试统一两个同时 let 的 RHS 并陷入我在一侧处理 let 绑定的情况漂浮他们的时间。所以，实际上 Maybe 参数上没有聪明的结构可以利用，我实际上没有 computeing Int。

到目前为止的答案可能会使其他人受益，而不仅仅是他们给我带来的启发，所以谢谢！

编辑 2：这是一些编译示例代码，可能带有伪造的语义：

module Unify (unify) where

import Control.Applicative
import Control.Monad.Trans.State.Strict

data Expr
  = Var String -- meta, free an bound vars
  | Let String Expr Expr
  -- ... more cases
  -- no Eq instance, fwiw

-- | If the two terms unify, return the most general unifier, e.g.
-- a substitution (`Map`) of meta variables for terms as association
-- list.
unify :: [String] -> Expr -> Expr -> Maybe [(String, Expr)]
unify metaVars l r = execStateT (go [] [] l r) [] -- threads the current substitution as state
  where
    go locals floats (Var x) (Var y)
      | x == y = return ()
    go locals floats (Var x) (Var y)
      | lookup x locals == Just y = return ()
    go locals floats (Var x) e
      | x `elem` metaVars = tryAddSubstitution locals floats x e
    go locals floats e (Var y)
      | y `elem` metaVars = tryAddSubstitution locals floats y e
    -- case in point:
    go locals floats (Let x lrhs lbody) (Let y rrhs rbody) = do
      go locals floats lrhs rrhs -- try this one, fail current pattern branch if rhss don't unify
      -- if we get past the last statement, commit to this branch, no matter
      -- the next statement fails or not
      go ((x,y):locals) floats lbody rbody
    -- try to float the let binding. terms mentioning a floated var might still
    -- unify with a meta var
    go locals floats (Let x rhs body) e = do
      go locals (Left (x,rhs):floats) body e
    go locals floats e (Let y rhs body) = do
      go locals (Right (y,rhs):floats) body e

    go _ _ _ _ = empty

    tryAddSubstitution = undefined -- magic

Answer 1

如果您单独使用 Maybe，您可以使用模式守卫来做到这一点：

import Control.Monad
import Control.Applicative

ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p a = a <$ guard (p a)

compute :: Int -> Maybe Int
compute = return

f :: Maybe Int -> Maybe Int -> Maybe Int
f (Just m) (Just n)
    | Just x <- ensure (== 42) =<< compute (m + n)
    = return x
f (Just m) _
    | Just x <- ensure (== 42) =<< compute m
    = return x
f _ (Just n)
    | Just x <- ensure (== 42) =<< compute n
    = return x
f _ _ = empty

(ensure 是通用组合子。参见 )

但是，由于您在顶部有 StateT，因此您必须提供一个状态才能在 Maybe 上进行模式匹配，这会搞砸一切。既然如此，您最好使用 "ugly" 解决方案中的一些东西。这是一个改进外观的异想天开的尝试：

import Control.Monad
import Control.Applicative
import Control.Monad.State
import Control.Monad.Trans
import Data.Foldable

ensure :: Alternative f => (a -> Bool) -> a -> f a
ensure p a = a <$ guard (p a)

compute :: Int -> StateT () Maybe Int
compute = return

f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f a b = asum (map (\c -> f' (c a b)) [liftA2 (+), const, flip const])
    where
    f' = ensure (== 42) <=< compute <=< lift

While this is an answer specific to the snippet I've given, the refactorings only apply limited to the code I was facing.

也许将上面的 asum 表达式的骨架提取到更通用的组合器并不是 far-fetched 的想法：

-- A better name would be welcome.
selector :: Alternative f => (a -> a -> a) -> (a -> f b) -> a -> a -> f b
selector g k x y = asum (fmap (\sel -> k (sel x y)) [g, const, flip const])

f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f = selector (liftA2 (+)) (ensure (== 42) <=< compute <=< lift)

虽然组合器可能有点笨拙，但 selector 确实表明该方法比最初看起来更通用：唯一重要的限制是 k 必须产生结果在某些 Alternative 上下文中。

P.S.: 虽然用 (<|>) 而不是 asum 写 selector 可以说更有品味......

selector g k x y = k (g x y) <|> k x <|> k y

... asum 版本直接概括为任意数量的 pseudo-patterns:

selector :: Alternative f => [a -> a -> a] -> (a -> f b) -> a -> a -> f b
selector gs k x y = asum (fmap (\g -> k (g x y)) gs)

Answer 2

当我需要这样的东西时，我只使用 asum 和内联的块。这里我也把多个模式Just n1 <- pure a; Just n2 <- pure b压缩成了一个，(Just n1, Just n2) <- pure (a, b).

f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f a b = asum

  [ do
    (Just n1, Just n2) <- pure (a, b)
    m <- compute (n1 + n2) 
    guard (m == 42)

  , do
    Just n <- pure a
    m <- compute n
    guard (m == 42)

  , do
    Just n <- pure b
    m <- compute n
    guard (m == 42)

  ]

如果您愿意，也可以使用 <|> 的链：

f :: Maybe Int -> Maybe Int -> StateT () Maybe ()
f a b

  = do
    (Just n1, Just n2) <- pure (a, b)
    m <- compute (n1 + n2) 
    guard (m == 42)

  <|> do
    Just n <- pure a
    m <- compute n
    guard (m == 42)

  <|> do
    Just n <- pure b
    m <- compute n
    guard (m == 42)

对于这种“掉线”，这是您所能获得的最小值。

Answer 3

看起来你可以通过 Int 形成一个 Monoid 添加和 0 作为标识元素这一事实来摆脱整个模式匹配，并且如果 a 成立，Maybe a 形成 Monoid。那么你的函数就变成了：

f :: Maybe Int -> Maybe Int -> StateT () Maybe Int
f a b = pure $ a <> b >>= compute >>= pure . mfilter (== 42)

您可以通过将谓词作为参数传递来概括：

f :: Monoid a => (a -> Bool) -> Maybe a -> Maybe a -> StateT () Maybe a
f p a b = pure $ a <> b >>= compute >>= pure . mfilter p

唯一的问题是 compute 现在将 Maybe Int 作为输入，但这只是在该函数内部调用 traverse 的问题，无论您需要做什么计算.

编辑：考虑到你上次的编辑，我发现如果你将你的模式匹配分散到可能失败的单独计算中，那么你可以只写

f a b = f1 a b <|> f2 a b <|> f3 a b
  where f1 (Just a) (Just b) = compute (a + b) >>= check
        f1 _        _        = empty
        f2 (Just a) _        = compute a >>= check
        f2 _        _        = empty
        f3 _        (Just b) = compute b >>= check
        f3 _        _        = empty
        check x              = guard (x == 42)

`Alternative` 中的模式匹配

Pattern matching in `Alternative`

monads

haskell

pattern-matching