如何编写 Continuation Monad 的 Functor 实例？

Question

newtype Cont k a = Cont { runCont :: (a -> k) -> k }

instance Functor (Cont k) where
  -- fmap :: (a -> b) -> (Cont k a) -> (Cont k b)
  fmap f (Cont akTok) = Cont $ ???

我的疑惑：

1. 我们只能将 Functor 实例写入任何可以产生类型 out 的数据类型（例如：[a]、Maybe a、(y -> a)），但不能写入使用类型的数据类型.现在在上面的数据类型中，它消耗了一个消耗 a 的函数，那么这种间接消耗如何被认为是产生了一个 a 类型。这意味着我们不能为 (k -> a) -> k 编写 Functor 实例？

2. 如何读取 Cont 数据类型。 Cont 有 a 时会产生 k？ （就像 Javascript XHR 回调在从服务器获取数据时产生 JSON 一样？）

3. 如何为 Cont 数据类型编写 QuickCheck 测试用例

import Test.QuickCheck
import Test.QuickCheck.Checkers
import Test.QuickCheck.Classes

newtype Cont k a = Cont { runCont :: (a -> k) -> k }

instance Functor (Cont k) where
   ...

instance Applicative (Cont k) where
   ...

instance Monad (Cont k) where
   ...

instance (Arbitrary a, Arbitrary b) => Arbitrary (Cont k a) where
    arbitrary = do
        -- akTok <- arbitrary -- How to generate Arbitrary functions like this
        return $ Cont akTok

instance (Eq k, Eq a) => EqProp (Cont k a) where
    (=-=) = eq -- How can I test this equality

main :: IO ()
main = do
    let trigger :: Cont ???
        trigger = undefined
    quickBatch $ functor trigger
    quickBatch $ applicative trigger
    quickBatch $ monad trigger

Answer 1

由于任何类型最多有一个有效的Functor，因此很容易机械地解决它。事实上，我们可以让编译器为我们做这些艰苦的工作：

GHCi, version 8.6.5: http://www.haskell.org/ghc/  :? for help
Prelude> :set -ddump-deriv -XDeriveFunctor
Prelude> newtype Cont k a = Cont { runCont :: (a -> k) -> k } deriving(Functor)

==================== Derived instances ====================
Derived class instances:
  instance GHC.Base.Functor (Ghci1.Cont k) where
    GHC.Base.fmap f_a1xR (Ghci1.Cont a1_a1xS)
      = Ghci1.Cont
          ((\ b5_a1xT b6_a1xU
              -> (\ b4_a1xV -> b4_a1xV)
                   (b5_a1xT
                      ((\ b2_a1xW b3_a1xX
                          -> (\ b1_a1xY -> b1_a1xY) (b2_a1xW (f_a1xR b3_a1xX)))
                         b6_a1xU)))
             a1_a1xS)
    (GHC.Base.<$) z_a1xZ (Ghci1.Cont a1_a1y0)
      = Ghci1.Cont
          ((\ b6_a1y1 b7_a1y2
              -> (\ b5_a1y3 -> b5_a1y3)
                   (b6_a1y1
                      ((\ b3_a1y4 b4_a1y5
                          -> (\ b2_a1y6 -> b2_a1y6)
                               (b3_a1y4 ((\ b1_a1y7 -> z_a1xZ) b4_a1y5)))
                         b7_a1y2)))
             a1_a1y0)


Derived type family instances:


Prelude>

这是一团糟，但很容易简化（只需重命名一些变量，删除基本上是id 的函数，并使用. 而不是手写）：

instance Functor (Cont k) where
  fmap f (Cont k2) = Cont (\k1 -> k2 (k1 . f))

考虑Op 并根据Contravariant 实例定义您的Functor 也可能很有启发性：

import Data.Functor.Contravariant

instance Functor (Cont k) where
  fmap f = Cont . getOp . contramap (getOp . contramap f . Op) . Op . runCont

或者可能更容易理解，带有一些扩展：

{-# LANGUAGE ScopedTypeVariables, TypeApplications #-}

import Data.Coerce
import Data.Functor.Contravariant

instance Functor (Cont k) where
  fmap f = coerce (contramap @(Op k) (contramap @(Op k) f))

或者完全忽略那个类型类，只是注意到它的contramap = flip (.)：

instance Functor (Cont k) where
  fmap f = Cont . contramapFunc (contramapFunc f) . runCont
    where contramapFunc = flip (.)

这是可行的，因为双倍的逆变函子会产生一个协变函子。

另一种选择是删除新类型包装器，然后播放俄罗斯方块：

instance Functor (Cont k) where
  fmap f = Cont . fmapRaw f . runCont
    where
      fmapRaw :: (a -> b) -> ((a -> k) -> k) -> (b -> k) -> k
      fmapRaw f k2 k1 = k2 (k1 . f)

在这里，我们有一个a -> b、一个(a -> k) -> k和一个b -> k，我们需要将它们组合起来得到一个k。如果我们将b -> k 与a -> b 组合在一起，我们将得到一个a -> k，然后我们可以将其传递给(a -> k) -> k 以得到一个k。