剥离 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 的实例，在本例中我们希望成为 foldMap 的函数：

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

由于foldMap f 最终成为Foldable 类型上的广义mconcat . map f 而不仅仅是列表，因此用作“预处理器”的函数用于连接到传递给ala' 的高阶函数（ foldMap)，然后在这种情况下处理一些 Foldable t => t Node。如果您不想要预处理步骤，您只需使用ala，它使用id 作为其预处理器。由于其复杂的类型，使用此函数有时会很困难，但正如文档中的示例所示，foldMap 通常是一个不错的选择。

如果您想为Maybe String 编写自己的newtype 包装器，其强大之处在于：

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

如果您使用的是Data.Monoid.First，那么这只是getFirst。许多新类型包装器使用记录语法来提供一个简单的函数来解开新类型。

Answer 3

元编程看起来过于复杂。我会简单地使用

unFirst (First x) = x  -- define once, use many times

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

通常情况下，函数与新类型一起定义，例如

newtype First a = First { unFirst :: a }

Answer 4

正如 Zeta 在 cmets 中建议的那样，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