Search code examples
haskellcontinuationsquickcheckcontinuation-passing

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 $ ???

My doubts:

  1. We can only write Functor instance to any data type that can produce a type out (ex: [a], Maybe a, (y -> a)), but not for the data types that consumes a type. Now in the above data type it consumes a function that consumes a then how does this indirect consumption's can be considered as producing a type a. That means we cannot write Functor instance for (k -> a) -> k?

  2. How can I read the Cont data type. Cont produces k when it have a? (Just like Javascript XHR callback produces JSON when it have response from fetching data from server?)

  3. How to write QuickCheck test cases for Cont data type

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

Solution

  • Since there's at most one valid Functor for any type, it's easy to mechanically solve for it. In fact, we can make the compiler do the hard work for us:

    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>
    

    That's a big mess, but it's easy to simplify (just rename some variables, remove functions that are basically id, and use . instead of writing it out by hand):

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

    It may also be enlightening to consider Op, and defining your Functor in terms of its Contravariant instance:

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

    Or possibly more easily understandable, with some extensions:

    {-# 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))
    

    Or foregoing that typeclass entirely, and just noting that its contramap = flip (.):

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

    This works since doubled contravariant functors yield a covariant functor.

    Yet another option is to remove the newtype wrapper and then just play type Tetris:

    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)
    

    Here, we have an a -> b, an (a -> k) -> k, and a b -> k, and we need to combine them to get a k. If we compose the b -> k with the a -> b, we get an a -> k, and we can then give that to the (a -> k) -> k to get a k.