剥离newtype构造函数

Question

我经常编写正在剥离新类型的唯一构造函数的函数,例如在以下函数中返回第一个不是Nothing的参数:

process (Pick xs) = (\(First x) -> x) . mconcat . map (First . process) $ xs

我认为lambda是不必要的冗长.我想写这样的东西:

process (Pick xs) = -First . mconcat . map (First . process) $ xs

Haskell的元编程工具是否允许类似的东西？以更简洁的方式解决这个问题的任何其他解决方案也是受欢迎的.

UPD.已经要求整个代码:

data Node where
  Join :: [Node] -> Node
  Pick :: [Node] -> Node
  Given :: Maybe String -> Node
  Name :: String -> Node

process :: Node -> Maybe String
process (Join xs) = liftM os_path_join (mapM process xs)
process (Pick xs) = getFirst . mconcat . map (First . process) $ xs
process (Name x) = Just x
process (Given x) = x

Answer 1

在这种情况下,您可以实际使用该newtypes包来更一般地解决此问题:

process :: Node -> Maybe String
process (Pick xs) = ala' First foldMap process xs
process (Join xs) = liftM os_path_join (mapM process xs)
process (Name x) = Just x
process (Given x) = x

你甚至可以有一个更宽泛的版本,需要一个Newtype n (Maybe String)像

process'
    :: (Newtype n (Maybe String), Monoid n)
    => (Maybe String -> n) -> Node -> Maybe String
process' wrapper (Pick xs) = ala' wrapper foldMap (process' wrapper) xs
process' wrapper (Join xs) = liftM os_path_join (mapM (process' wrapper) xs)
process' wrapper (Name x) = Just x
process' wrapper (Given x) = x

然后

> let processFirst = process' First
> let processLast = process' Last
> let input = Pick [Given Nothing, Name "bar", Given (Just "foo"), Given Nothing]
> processFirst input
Just "bar"
> ProcessLast input
Just "foo"

作为一个如何工作的解释,该ala'函数采用newtype包装器来确定Newtype要使用的实例,在这种情况下我们想要的函数是foldMap:

foldMap :: (Monoid m, Foldable t) => (a -> m) -> t a -> m

因为foldMap f最终是一个泛化mconcat . map f的Foldable类型而不仅仅是列表,然后一个函数用作挂钩到传递给ala'(foldMap)的高阶函数的"预处理器" ,然后在这种情况下Foldable t => t Node要处理一些.如果您不想使用预处理步骤,那么ala它将id用于预处理器.由于其复杂的类型,有时使用此功能很困难,但是文档中的示例foldMap通常是一个不错的选择.

这样做的好处是,如果你想为自己编写自己的newtype包装器Maybe String:

newtype FirstAsCaps = FirstAsCaps { getFirstAsCaps :: Maybe String }

firstAsCaps :: Maybe String -> FirstAsCaps
firstAsCaps = FirstAsCaps . fmap (fmap toUpper)

instance Monoid FirstAsCaps where
    mempty = firstAsCaps Nothing
    mappend (FirstAsCaps f) (FirstAsCaps g)
        = FirstAsCaps $ ala First (uncurry . on (<>)) (f, g)

instance Newtype FirstAsCaps (Maybe String) where
    pack = firstAsCaps
    unpack = getFirstAsCaps

然后

> process' firstAsCaps input
Just "BAR"

Answer 2

正如 Zeta 在评论中建议的那样，coerce这是一种很好的通用方法：

process (Pick xs) = coerce . mconcat . map (First . process) $ xs

另一个好处coerce是，您可以使用它来强制类型构造函数的“内部”，而无需运行时成本，如下所示：

example :: [Sum Int] -> [Int]
example = coerce

另一种选择，map getFirst，会导致遍历的运行时开销map。

另外，每次你创建一个 时newtype，GHC 都会自动创建适当的Coercible实例，因此你永远不必担心弄乱底层机器（你甚至不需要deriving它）：

newtype Test = Test Char

example2 :: Maybe Test -> Maybe Char
example2 = coerce