“替代”

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-bindings），如果可能的话，我想尝试统一两个同步的RHS，然后落到我处理的情况下让一边绑定漂浮他们的时间。所以，实际上Maybe个参数上没有聪明的结构可供使用，我实际上并不是compute 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是一个通用组合器。见Lift to Maybe using a predicate）

但是，如果你有StateT在顶部，你必须提供一个状态才能在Maybe上进行模式匹配，这将会破坏一切。既然如此，你可能会在你的“丑陋”解决方案中找到更好的东西。这是一个异想天开的尝试，以改善其外观：

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

  

虽然这是我给出的代码段的特定答案，但重构只适用于我所面对的代码。

将上面的asum表达式的骨架提取到一个更通用的组合器中，也许并不是一个牵强附会的想法：

-- 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。：用selector而不是(<|>)写asum可以说更有品味......

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

... asum版本直接推广为任意数量的伪模式：

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作为标识元素的事实来摆脱整个模式匹配，并Maybe a 1}}如果Monoid，则形成a。然后你的功能变为：

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。< / p>

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

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)