Haskell 中的泛化函数

Question

这两个功能几乎相同：

dig :: MappingClassifierM FileSummary IO Partitioner -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)
dig classifier =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify classifier clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig classifier
        else do
          mapM_ (yield . cluster) categories
          dig classifier
      where
        cluster (key, val) = Cluster (key : clusterKey) val
        classify = classifyM

dig' :: BinaryClassifierM FileSummary IO -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)
dig' classifier =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify classifier clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig' classifier
        else do
          mapM_ (yield . cluster) categories
          dig' classifier
      where
        cluster = Cluster (Content : clusterKey)
        classify = classifyBinary

唯一的区别在于 where 子句中定义的函数。

以下限制适用：

• classify 函数取决于作为第一个参数传递的分类器的“类型”。
• cluster 函数取决于分类器的实际实现。

我想概括这两个函数，以便创建一个处理这两个实现以避免重复的单个函数。

我不知道我的方向是否正确。根据我迄今为止对 Haskell 的有限了解，我认为我必须创建一个类“分类器”，其中 BinaryClassifier 和 MappingClassifierM 将是其实例，但是当我尝试实现它时遇到了几个编译错误.

所以，我的问题是：有经验的 Haskell 程序员如何概括这两个函数以避免重复？

对于其他上下文，以下是我试图概括的两种不同情况的相关类型签名：

type MappingClassifierM a m k = a -> m k
classifyM :: (Monad m, Ord k) => MappingClassifierM a m k -> [a] -> m [(k, [a])]
dig :: MappingClassifierM FileSummary IO Partitioner -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)

type BinaryClassifierM a m = a -> a -> m Bool
classifyBinary :: Monad m => BinaryClassifierM a m -> [a] -> m [[a]]
dig' :: BinaryClassifierM FileSummary IO -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)

Answer 1

我的方法是让编译器为我做大部分的思考。首先，我把通用代码做成了自己的函数

dig'' classifier =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify classifier clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig'' classifier
        else do
          mapM_ (yield . cluster) categories
          dig'' classifier

这会导致几个问题。首先，编译器抱怨cluster 和classify 是未定义的，所以我们需要将它们作为参数添加到函数中。您还会注意到分类器从未在分类函数之外使用，因此我们将它们组合成一个值。此外，由于我们更改了函数的参数，我们的递归调用也发生了变化，所以我们需要处理这些。

dig'' cluster =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig'' cluster classify
        else do
          mapM_ (yield . cluster) categories
          dig'' cluster classify

在这里我注意到 where 子句中的 cluster 需要 clusterKey，因此需要以某种方式作为参数传入。

dig'' cluster =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig'' cluster classify
        else do
          mapM_ (yield . cluster clusterKey) categories
          dig'' cluster classify

最后，使用类型漏洞让 ghc 为我找出数据类型。

dig'' :: _
dig'' cluster =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify clusterValue
      if (length clusterValue == length categories)
        then do
          yield $ Cluster clusterKey clusterValue
          dig'' cluster classify
        else do
          mapM_ (yield . cluster clusterKey) categories
          dig'' cluster classify

我的值是

(Foldable t, MonadIO m) =>
 ([a] -> a1 -> Cluster a b)
 -> ([b] -> IO (t a1)) -> Conduit (Cluster a b) m (Cluster a b)

但您的结果可能会有所不同，因为我在很大程度上构成了所有数据类型。例如，我怀疑 [a] 和 [b] 对于您的代码会有所不同。

现在，回到原来的功能。在这里，我们的优势在于已经知道结果的类型。

dig :: MappingClassifierM FileSummary IO Partitioner -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)
dig classifier = dig'' ????

现在我们只需要dig'' 的两个参数。第一个参数只是填写cluster定义，所以我们得到

(\clusterKey (key, val) -> Cluster (key : clusterKey) val)

第二个参数是分类，我们在分类器中滚动到它，所以它很简单 (classifyM 分类器)

因此，最终的定义是

dig :: MappingClassifierM FileSummary IO Partitioner -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)
dig classifier = dig'' (\clusterKey (key, val) -> Cluster (key : clusterKey) val) (classifyM classifier)

同样，你也可以找到

dig' :: BinaryClassifierM FileSummary IO -> Conduit (Cluster Partitioner FileSummary) IO (Cluster Partitioner FileSummary)
dig' classifier = dig'' (\clusterKey -> Cluster (Content : clusterKey)) (classifyBinary classifier)

Answer 2

我能够使用允许某些语言扩展的类找到替代解决方案：

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}

class Classifier classifier a m c | classifier -> m c where
  classify :: (Monad m) => classifier -> [a] -> m [c]
  cluster :: classifier -> [Partitioner] -> c -> Cluster Partitioner a

instance Classifier (MappingClassifierM FileSummary IO Partitioner) FileSummary IO (P
  classify = classifyM
  cluster _ x (key, val) = Cluster (key : x) val

instance Classifier (BinaryClassifierM FileSummary IO) FileSummary IO [FileSummary] w
  classify = classifyBinary
  cluster _ clusterKey = Cluster (Content : clusterKey)

dig :: (Classifier classifier FileSummary IO c) => classifier -> Conduit (Cluster Par
dig classifier =
  await >>= \case
    Nothing -> return ()
    Just ( Cluster clusterKey clusterValue ) -> do
      categories <- liftIO $ classify classifier clusterValue

      when (length clusterValue == length categories) $
        yield $ Cluster clusterKey clusterValue

      when (length clusterValue /= length categories) $
        mapM_ (yield . (cluster classifier clusterKey)) categories

      dig classifier