在 Haskell 中展平 Maybe 结构

Flatten Maybe structure in Haskell

我认为 Control.Monadjoin 具有与 JavaScript 中的 Array.flat 相同的能力。

https://developer.mozilla.org/docs/Web/JavaScript/Reference/Global_Objects/Array/flat

然而,这出乎我的意料,实际情况是

f :: Maybe a -> Maybe a
f = \a -> join (Just a) -- works as I expected

f' :: a -> Maybe a
f' = \a -> join (Just a) -- I thought it returns Maybe a
-- Occurs check: cannot construct the infinite type: a ~ Maybe a
-- Expected type: Maybe (Maybe a)     
-- Actual type:   Maybe a

是否有可用的展平功能或任何解决方法?

join 总是将两层完全压平为一层。理想情况下,我们希望表达类似“递归地展平任何嵌套层;如果我们下降到一层,什么都不做”。这需要像

这样的类型
type family Flattened x where
  Flattened (m (m a)) = Flattened (m a)
  Flattened (m a) = m a

flatten :: x -> Flattened x

实际上,这不能(AFAIK)这样实现,我们需要一些重型机械:

{-# LANGUAGE TypeFamilies, GADTs, ConstraintKinds
        , MultiParamTypeClasses, FlexibleInstances
        , RankNTypes, UnicodeSyntax
        , ScopedTypeVariables, AllowAmbiguousTypes, TypeApplications #-}

import Control.Monad

type family Stripped m x where
  Stripped m (m a) = Stripped m a
  Stripped m x = x

type Bare m x = Stripped m x ~ x

data DepthSing m x where
  BareSing :: Bare m x => DepthSing m x
  DeepSing :: KnownDepth m x => DepthSing m (m x)

class KnownDepth m x where
  depth :: DepthSing m x

flatten :: ∀ m x . (Monad m, KnownDepth m x) => m x -> m (Stripped m x)
flatten p = case depth @m @x of
   BareSing -> p
   DeepSing -> flatten $ join p

instance KnownDepth m Char where
  depth = BareSing

instance KnownDepth m a => KnownDepth m (m a) where
  depth = DeepSing

现在

*Main> flatten (Just (Just 'v'))
Just 'v'
*Main> flatten (Just (Just (Just 'w')))
Just 'w'
*Main> flatten (Just 'i')
Just 'i'

尴尬的是我们需要为每个“原始”类型创建一个专用的 KnownDepth 实例。

instance KnownDepth m Int where depth = BareSing
instance KnownDepth m Bool where depth = BareSing
...

也许 -XIncoherentInstances 可以提供帮助,但这是我不会触及的扩展。

一个更糟糕的问题是这不适用于扁平化,例如Maybe (Maybe [Int])Maybe [Int],我们需要 二次方许多 个实例:

instance KnownDepth Maybe [x] where depth = BareSing
instance KnownDepth Maybe (Either c x) where depth = BareSing
...
instance KnownDepth [] (Maybe x) where depth = BareSing
instance KnownDepth [] (Either c x) where depth = BareSing
...
instance KnownDepth (Either c) [x] where depth = BareSing
instance KnownDepth (Either c) (Maybe x) where depth = BareSing
...
...

如果您还想要 'w' -> Just 'w' 行为,可以通过

flatten' :: ∀ m x . (Monad m, KnownDepth m x) => x -> m (Stripped m x)
flatten' p = case depth @m @x of
   BareSing -> return p
   DeepSing -> flatten p