免费monad和类型约束

时间:2015-12-13 16:14:36

标签: haskell polymorphism constraints typeclass

我正在寻找处理haskell约束的实用策略或技巧,如下面的例子所示。

我有一个仿函数Choice,我想将一个解释器从Choice x仿函数转换为m x,转换为Free Choice xm x的解释器。

-- Choice : endofunctor  
data Choice next = Choice next next deriving (Show)
instance Functor Choice where 
   fmap f (Choice a b) = Choice (f a) (f b)

-- I have a function from the functor to a monad m
inter1 :: Choice x -> IO x
inter1 (Choice a b) = do 
  x <- readLn :: IO Bool 
  return $ if x then a else b

-- universal property gives me a function from the free monad to m 
go1 :: Free Choice x -> IO x
go1 = interpMonad inter1

,其中

type Free f a = FreeT f Identity a
data FreeF f r x = FreeF (f x) | Pure r deriving (Show)
newtype FreeT f m r = MkFreeT { runFreeT :: m (FreeF f r (FreeT f m r)) }

instance Show (m (FreeF f a (FreeT f m a))) => Show (FreeT f m a) where
  showsPrec d (MkFreeT m) = showParen (d > 10) $
    showString "FreeT " . showsPrec 11 m

instance (Functor f, Monad m) => Functor (FreeT f m) where
    fmap (f::a -> b) (x::FreeT f m a)  =
        MkFreeT $ liftM f'  (runFreeT x)
                where f' :: FreeF f a (FreeT f m a) -> FreeF f b (FreeT f m b)
                      f' (FreeF (fx::f (FreeT f m a))) =  FreeF $ fmap (fmap f) fx
                      f' (Pure r) = Pure $ f r

instance (Functor f, Monad m) => Applicative (FreeT f m) where
  pure a = MkFreeT . return $ Pure a
  (<*>) = ap

instance (Functor f, Monad m) => Monad (FreeT f m) where
    return = MkFreeT . return . Pure
    (MkFreeT m) >>= (f :: a -> FreeT f m b)  =  MkFreeT $ -- m (FreeF f b (FreeT f m b))
           m  >>= -- run the effect in the underlying monad !
             \case FreeF fx -> return . FreeF . fmap (>>= f) $ fx -- continue to run effects
                   Pure r -> runFreeT (f r) -- apply the transformation

interpMonad :: (Functor f, Functor m, Monad m) =>
               (forall x . f x -> m x) ->
               forall x. Free f x -> m x
interpMonad interp (MkFreeT iFfxF) = (\case
      Pure x -> return x
      FreeF fxF -> let mmx =  interp $ fmap (interpMonad interp) fxF
                   in join mmx) . runIdentity $ iFfxF

在我的翻译中需要Show x之前一切正常。

interp2 :: Show x => Choice x -> IO x
interp2 (Choice a b) = return a -- we follow left


go2 :: Show x => Free Choice x -> IO x
go2  = interpMonad interp2   -- FAILS

然后找不到要在interp2中应用的show约束

我怀疑量词是问题,所以我简化为

lifting :: (forall x . x -> b) ->
           (forall x.  x -> b)
lifting = id

lifting2 :: (forall x . Show x => x -> b) ->
            (forall x . Show x => x -> b)
lifting2 = id


somefunction :: Show x => x -> String
somefunction = lifting show    -- FAILS

somefunction2 :: Show x => x -> String
somefunction2 = lifting2 show  -- OK

这突出了问题:Could not deduce (Show x1) arising from a use of ‘show’ from the context (Show x)我们有两个不同的类型变量,约束不会从一个变为另一个。

我可以编写一些专门的函数来玩限制如下(不起作用)但我的问题是处理这个问题的实际策略是什么? (相当于未定义,查看类型,继续...)

interpMonad2 :: (Functor f, Functor m, Monad m) =>
               (forall x . ( Show (f x)) => f x -> m x) ->
               forall x.  ( Show (Free f x)) => Free f x -> m x
interpMonad2 interp (MkFreeT iFfxF) = (\case
      Pure x -> return x
      FreeF fxF -> let mmx =  interp $ fmap (interpMonad interp) fxF
                   in join mmx) . runIdentity $ iFfxF

修改

根据提供的答案,这里是lifting函数的修改。

lifting :: forall b c. Proxy c
           ->  (forall x . c x => x -> b)
           ->  (forall x . c x => x -> b)
lifting _ = id


somefunction3 :: Show x => x -> String
somefunction3 = lifting (Proxy :: Proxy Show) show

1 个答案:

答案 0 :(得分:3)

我没有看到你的interpMonad功能,所以我将在这里包含一个可能的定义:

interpMonad :: forall f m x . (Functor f, Monad m) 
            => (forall y . f y -> m y) -> Free f x -> m x 
interpMonad xx = go . runIdentity . runFreeT  where 
  go (FreeF x) = xx x >>= go . runIdentity . runFreeT
  go (Pure  x) = return x 

为了对内部函数也有类约束,只需将约束添加到内部函数即可。您还需要对Free类型的正确约束,并且需要额外的Proxy来帮助typechecker。否则,函数的定义是相同的:

interpMonadC :: forall f m x c . (Functor f, Monad m, c (Free f x)) 
             => Proxy c 
             -> (forall y . c y => f y -> m y) 
             -> (Free f x -> m x) 
interpMonadC _ xx = go . runIdentity . runFreeT  where 
  go (FreeF x) = xx x >>= go . runIdentity . runFreeT
  go (Pure  x) = return x 

现在非常简单:

>:t interpMonadC (Proxy :: Proxy Show) interp2
interpMonadC (Proxy :: Proxy Show) interp2
  :: Show x => Free Choice x -> IO x