如何编写 Continuation Monad 的 Functor 实例?

How to write Functor instance of Continuation Monad?

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 实例写入任何可以产生类型的数据类型(例如:[a],Maybe a,(y -> a)),但不能写入数据类型消耗一个类型。现在在上面的数据类型中,它消耗了一个消耗 a 的函数,那么如何将这种间接消耗视为生成类型 a。这意味着我们不能为 (k -> a) -> k?

  2. 编写 Functor 实例
  3. 如何读取 Cont 数据类型。 Cont 在有 a 时产生 k? (就像 Javascript XHR 回调在从服务器获取数据有响应时产生 JSON 一样?)

  4. 如何为 Cont 数据类型

  5. 编写 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

由于任何类型最多有一个有效的 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 -> ka -> b 组合在一起,我们会得到一个 a -> k,然后我们可以将其提供给 (a -> k) -> k 以获得 k