haskell - `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)

像 execStateT (f (Just 42) (Just 1)) () 这样的调用对于 f 会失败，但会返回 Just ()对于 f'，因为它与 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绑定(bind))，如果可能的话，我想尝试统一两个同时let的RHS，并陷入我在一侧处理let绑定(bind)的情况一次让它们漂浮。因此，实际上，Maybe 参数上没有巧妙的结构可供利用，而且我实际上并没有在 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

当我需要这样的东西时，我只需使用 asum与内嵌的 block 。这里我也浓缩了多种模式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)

这对于这种“失败”来说是尽可能少的。