剥离新类型构造函数

Stripping the newtype constructor

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

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

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

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

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

更新。已请求完整代码:

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

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

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

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

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

函数和新类型一起定义的情况很常见,例如

newtype First a = First { unFirst :: a }

在这种情况下,您实际上可以使用 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 最终是 mconcat . map fFoldable 类型的泛化,而不仅仅是列表,那么一个函数用作 "preprocessor" 用于连接到更高的-order 函数被传递给 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"

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

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

coerce 的另一个好处是,您可以使用它来强制 "inside" 类型构造函数而无需运行时成本,如下所示:

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

备选方案 map getFirst 会导致 map 遍历的运行时开销。

此外,每次您创建 newtype 时,GHC 都会自动创建适当的 Coercible 实例,因此您永远不必担心弄乱底层机制(您甚至不需要 deriving 为它):

newtype Test = Test Char

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