代数效应似乎是函数式编程中的一种圣杯。当我在这里说“代数效应”时，我的意思是：将任何效应视为程序中的值或类型，同时还有一些简单的运算（代数）来组合效应。这实际上是什么样子的？想到的两种语言是 Idris 和 PureScript。当您使用他们的效果支持进行编程时，您编写了 monadic 代码，但本质上有一个您可以从环境中提取的效果列表：日志记录、状态、IO 等。此外，您可以针对一堆效果进行编程，只需假设这些效果你需要的存在，允许我们根据需要任意增加效果堆栈。这是很不错的。不幸的是，我们无法在 Haskell 中访问这些工具。相反，haskellers 通常依赖于 mtl 或 Free Monads。我今天要展示的是一个接近 Idris 和 PureScript 的效果库，使用 van Laarhoven 编码的 Free Monad，配备了一个异构列表 (HList) 效果。我声称这具有 Idris 和 PureScript 中 Effect 工具的一些好处，与常规 Free Monads 相同的表现力，比 Church、Fused 或 Oleg 编码更高效的编码，并且只需要我们进行一些扩展。全部在大约 60 行代码中。 -- |我们使用显式的 `liftVL` 组合器用于说明目的。-- 在实际代码中，您将拥有自己的组合器。-- 发布 requestpostReq :: HasEffect 效果 Http => Url -> RequestBody -> FreeVL 效果 StatusCodepostReq url body = do resp <- liftVL (\http -> put http url body) return (statusCode resp)-- 取任意自由 monad 并用 loggingwithLog 包装它 :: HasEffect effects Logging => String -> String -> FreeVL effects a -> FreeVL 效果 awithLog preMsg postMsg program = do liftVL (\log -> infoLogger log preMsg) a <- program liftVL (\log -> infoLogger log postMsg) return a-- 用于定义解释器类型的具体效果列表 MyEffects = ( Http ': Logging ': Random ': State ': '[] )--作为值的解释器ioInterpreter :: Effects MyEffects IOioInterpreter = httpIO .: loggerIO .: randomIO .: stateIO .: EmptyEffect--实际运行我们的programmain :: IO ()main = interpret ioInterpreter (withLog "POST!" "phew! made it!" (postReq "https://weirdcanada.com" "rare=cool") ) 上面唯一缺少的部分是我们的效果（Http、Logger 等）的样子。下面是一个例子： -- HTTP effectdata Http m = Http { get :: Url -> m Response , put :: Url -> RequestBody -> m Response -- 等等 }-- Logging effectdata Logging m = Logging { infoLogger :: String -> m (), debugLogger :: String -> m ()-- 等等}
这篇文章的其余部分是用识字的haskell写的。我鼓励您剪切并粘贴此代码并自己玩！首先，让我们进行一些扩展和导入！ > {-# LANGUAGE DataKinds #-}> {-# LANGUAGE FlexibleContexts #-}> {-# LANGUAGE FlexibleInstances #-}> {-# LANGUAGE GADTs #-}> {-# LANGUAGE KindSignatures #-}> {-# LANGUAGE MultiParamTypeClasses #-}> {-# LANGUAGE PolyKinds #-}> {-# LANGUAGE RankNTypes #-}> {-# LANGUAGE TypeOperators #-}> > module Main where> > import Control.Arrow ((&&&))> import Control .Concurrent(threadDelay)> import Control.Exception(catch)> import Control.Lens((^.))> import Data.ByteString.Lazy(ByteString)> import Network.Wreq(get, post, Response, responseStatus, statusCode) > 导入 Network.HTTP.Client (HttpException(StatusCodeException))> 导入合格的 Network.HTTP.Types.Status 作为 S> 导入 System.Random (randomIO) 我向您推荐 Russell O'Connor 在 van Laarhoven Free Monad 上的精彩博文.这是一个简短而简洁的读物。从某种意义上说，van Laarhoven Free Monad 与普通单子是双重的。我们使用乘积而不是使用 sum 类型来对操作进行建模。 > -- 输入别名，使它看起来像真正的代码。> type Url = String> type RequestBody = ByteString> > -- 老式的自由单子编码> data Free effect a = Pure a> | Free (effect (Free effect a))> > -- 示例http效果：为简洁起见，使用Strings表示url和响应> data YeOldeHttp a = Get Url (Response ByteString -> a)> | Post Url RequestBody (Response ByteString -> a)> > -- 示例解释器> freeIOInterp :: Free YeOldeHttp a -> IO a> freeIOInterp (Pure a) = return a> freeIOInterp (Free (Get url next)) = get url > >= freeIOInterp 。 next> freeIOInterp (Free (Post url body next)) = post url body >>= freeIOInterp 。 next> > -- 示例组合器> oldGet :: Url -> Free YeOldeHttp (Response ByteString)> oldGet url = Free (Get url Pure) 给定一个效果，它本身是一个sum-type（每个分支不同的操作（例如Get , Put)) 我们可以证明 Free YeOldHttp a 是一个 monad（有关更多信息，请参阅 Gabriel 的博客文章）并针对它编写解释器，为其提供正确的语义。 Free Monads 的重要部分是我们可以编写不同的解释器，每个解释器都有自己的特定用途（测试、生产、调试等）。现在，van Laarhoven Free Monad 是一种不同的编码，需要您将效果表示为乘积而不是总和。上面的例子相当于： > -- (简单) van Laarhoven Free Monad encoding> newtype FreeVL1 effect a => FreeVL1 { runFreeVL1 :: forall m. Monad m => effect m -> ma }> > -- 例子Http effect> data NewHttp m => NewHttp { getNewHttp :: Url -> m (Response ByteString)> , postNewHttp :: Url -> RequestBody -> m (Response ByteString)> }> > -- 示例解释器> newHttpIO :: NewHttp IO> newHttpIO = NewHttp { getNewHttp = get, postNewHttp = post }> > freeVL1IOInterpreter :: FreeVL1 NewHttp a -> IO a> freeVL1IOInterpreter program = runFreeVL1 program newHttpIO> -- 示例组合> newGet :: Url -> FreeVL1 NewHttp (Response ByteString)> newGet url = FreeVL1 (\httpEffects -> getNewHttp httpEffects url)
FreeVL1 的好处在于它只是一个函数。要解释用 FreeVL1 NewHttp a 编写的程序，我们只需要提供 NewHttp m 类型的值，如上所示。这意味着针对 FreeVL1 NewHttp a 编写程序将具有与函数组合或 Reader monad 相同的运行时成本。将此与 Free 的常规编码进行对比，后者在绑定下执行得非常糟糕（它基本上是一个花哨的操作链表）。我们可以使用 Church-encoding 来大幅改善这一点，但它也有其他的权衡。现在，简单的 van Laarhoven 编码的缺点是我们一次只有一种效果。让我们看看我们如何改进它！我们现在的动机是创建新的效果（例如，也许我们想要日志、随机数等，而不是仅仅 Http）并将它们组合起来。在传统的 Free Monad 编码中这样做的一种方法是使用联产品（请参阅此处的博客文章）。由于每个 effect 都是一个 Functor，而 Functors 的 Co-Products 仍然是一个 Functor，这在技术上是可能的。然而，它使得从堆栈中提取效果以及编写和组合解释器变得非常麻烦。在 van Laarhoven 编码中，我们的效果已经是一个产品类型了。我们想要的是能够为我们的效果添加更多“字段”。例如，如果我们可以添加字段 log :: String -> m()，那几乎就像在我们的效果堆栈中添加一个记录器一样！添加字段的一种等效方法是创建一个 Heterogeneous 效果列表！如果我们不是将我们的效果产品“相乘”，而是将它们附加到一个异构列表中，那么我们就有了一种添加更多效果的方法，这与添加更多字段是同构的。让我们设计一个这样的 HList 并展示它如何使我们能够扩展以前的 van Laarhoven 编码！ > -- |我们的 HList of effects> -- 请注意，根据 van Laarhoven 编码，我们的效果是参数化的> -- 由一个 monad m.> data EffectStack a (m :: * -> *) where> EmptyEffect :: EffectStack '[] m> ConsEffect :: effect m -> EffectStack 效果 m -> EffectStack (effect ': effects) m
EffectStack 现在包含一个任意的效果列表，每个效果由 m 参数化。我们现在准备定义堆栈驱动的 van Laarhoven Free Monad： > -- van Laarhoven Free Monad with Effect Stacks encoding> newtype FreeVL effects a => FreeVL { runFreeVL :: forall m. Monad m => EffectStack effects m -> ma }> > -- 是的，它是一个monad> instance Functor (FreeVL effects) where> fmap f (FreeVL run) = FreeVL (fmap f .run)> > instance Applicative (FreeVL)效果) where> pure a = FreeVL (const (pure a))> (FreeVL fab) (FreeVL a) => FreeVL $ uncurry () 。 (fab &&& a)> > instance Monad (FreeVL effects) where> (FreeVL run) >>= f => FreeVL $ \effects -> run effects >>= \a -> runFreeVL (fa) effects > -- 解释一个van Laarhoven Free Monad with Effect Stacks> interperet :: Monad m> => EffectStack effects m> -> FreeVL effects a> -> ma> interperet interpreter program = runFreeVL program interpreter 不幸的是，我们还没有准备好以我们的新幻想编写程序免费的单子。我们需要构建具有任意效果堆栈的程序，为此，我们需要一种从 EffectStack 中提取效果并使用它的方法。为了实现这一点，我从 haskell-servant 的 Julian Arni 那里借用了一个技巧（你可以在这里看到他的代码）。本质上，我们创建了一个类型类，它能够在 EffectStack 中抓取 HList 并搜索我们想要的效果，然后返回它。 > -- 定义一个类型类，只有在有某种效果时才会编译> -- 存在于栈中，如果存在则返回。> class HasEffect (effects :: [((* -> *) -> *)]) (effect :: ((* -> *) -> *)) where> getEffect :: EffectStack effects m -> effect m> > -- 让我们提供一些`HasEffect`的实例，可以爬行EffectStack看> -- 对于匹配然后返回的效果。> > -- 第一个实例处理我们的效果类型与 HList 的 > -- 头部不匹配并进一步递归的情况。> 实例 {-# OVERLAPPABLE #- }> HasEffect effects effect => HasEffect (notIt ': effects) effect where> getEffect (ConsEffect _ effects) = getEffect effects> > -- 这个实例匹配我们的'effect'类型匹配head的情况> -- HList的.然后我们返回那个效果。> instance {-# OVERLAPPABLE #-}> HasEffect (effect ': effects) effect where> getEffect (ConsEffect effect _) = effect 那些类型类可能会让你有点想歪了（他们肯定会歪曲我的） ，但如果你自己写（我鼓励你这样做），你就会掌握它的窍门。 （PS - 我永远感谢朱利安的这个想法，因为它太方便了！）
现在我们有了选择效果的工具，我们可以开始编写组合器，让我们可以针对任意效果堆栈编写程序。 > -- 将操作提升到 van Laarhoven Free Monad>liftVL :: HasEffect 效果效果> -- ^ 约束强制我们的效果在效果堆栈中> => (forall m. effect m -> ma)> -- ^ 方法从我们的效果中提取我们的操作。> -> FreeVL effects a>liftVL getOp = FreeVL (\effects -> getOp (getEffect effects)) 让我们编写一些用户代码。我们将从定义三个效果开始： > -- HTTP Effect> data Http m => Http { getHttpEff :: Url -> m (Either Int (Response ByteString))> , postHttpEff :: Url -> RequestBody -> m (要么 Int (Response ByteString))> }> > -- Logging Effect> data Logging m = Logging { logEff :: String -> m () }> > -- 随机数效应> data Random m = Random { getRandEff :: m Int }> > -- suspend effect> data Suspend m = Suspend { suspendEff :: Int -> m () } 现在来看一些代码。让我们为每个效果中的每个运算符编写组合子。 > getHttp :: HasEffect 效果 Http> => Url> -> FreeVL 效果 (Either Int (Response ByteString))> getHttp url =liftVL (`getHttpEff` url)> > postHttp :: HasEffect 效果 Http> => Url> -> RequestBody> -> FreeVL 效果（Either Int (Response ByteString))> postHttp url body = liftVL (\http -> postHttpEff http url body)> > logMsg :: HasEffect effects Logging> => String> -> FreeVL effects ()> logMsg msg = LiftVL (`logEff` msg)> > getRand :: HasEffect 效果随机> => FreeVL 效果 Int> getRand = LiftVL getRandEff> > 暂停 :: HasEffect 效果 Suspend> => Int> -> FreeVL 效果 ()> 暂停i = liftVL (`suspendEff` i) 有了这些组合器，我们就可以编写程序了！让我们编写一个程序来发出一个网络请求，如果失败，则暂停 100 毫秒并重试。它将重试随机次数。
> repeatReq :: ( HasEffect effects Http> , HasEffect effects Random> , HasEffect effects Suspend> )> => Url> -> FreeVL effects (Either Int (Response ByteString))> repeatReq url = do> numRetries <- (flip mod 10) ) getRand> eResponse <- getHttp url> go numRetries eResponse> where> go 0 r = return r> go i _ = do> eResponse <- getHttp url> case eResponse of> r@(Right _) -> return r> l @(Left _) -> suspend 100 >> go (i-1) eResponse > withLog :: HasEffect effects Logging> => String> -> String> -> FreeVL effects a> -> FreeVL effects a> withLog preMsg postMsg program = do> logMsg preMsg> a <- program> logMsg postMsg> return a 最后，让我向您展示，我们可以通过将我们之前的 repeatReq 代码与日志记录和提供 url 一起包装来组合任意程序和效果堆栈。 > -- 让我们结合一些程序> program :: ( HasEffect effects Http> , HasEffect effects Random> , HasEffect effects Suspend> , HasEffect effects Logging> )> => FreeVL effects (Either Int (Response ByteString))> program = withLog "运行请求！” “完毕！” (repeatReq "http://aaronlevin.ca") 请注意，如果您删除这些约束之一（例如 Suspend），您将收到一个编译错误：01.lhs:313:49:Could not deduce (HasEffect effects Suspend ) 从上下文（HasEffect 效果 Http、HasEffect 效果随机、HasEffect 效果记录）中使用 'repeatReq' 产生，由程序的类型签名约束 ::（HasEffect 效果 Http、HasEffect 效果随机、HasEffect 效果记录）=> FreeVL effects (Maybe (Response ByteString)) at 01.lhs:(308,14)-(312,57) 在 'withLog' 的第三个参数中，即 '(repeatReq "http://aaronlevin.ca")' 中表达： withLog "正在运行的请求！" “完毕！” (repeatReq "http://aaronlevin.ca") 在 'program' 的等式中： program = withLog "running request!" “完毕！” (repeatReq "http://aaronlevin.ca") 现在我们已经编写了一些程序，我们需要提供一些解释器。我们将提供 IO 中的主要解释器，并将其作为练习留给读者来创建一个纯粹的解释器。
回想一下 van Laarhoven Free Monad 中的解释器只是一个 effect m 类型的值。同样，在效果堆栈版本中，它是一个 EffectStack 效果 m 类型的值，它只是我们效果的 HList。 > -- 一个使创建 HList 在语法上更好的组合器。> (.:.) :: effect m -> EffectStack effects m -> EffectStack (effect ': effects) m> effect .:. effects = ConsEffect effect effects> infixr 4 .:.> > -- 解释IO中的http动作> handleExcep :: HttpException -> Each Int a> handleExcep (StatusCodeException status _ _) = Left (S.statusCode status)> handleExcep _ =错误“未处理的 HttpException”> > httpIO :: Http IO> httpIO => Http { getHttpEff = \req -> (Right get req) `catch` (return .handleExcep)> , postHttpEff = \req body -> (Right post req body) `catch` (return .handleExcep)> }> > -- 解释 IO 中的日志操作> logIO :: Logging IO> logIO = Logging { logEff = putStrLn }> > -- IO 中的随机数生成器> randIO :: Random IO> randIO = Random { getRandEff = randomIO }> > -- 在IO中暂停> suspendIO :: Suspend IO> suspendIO = Suspend { suspendEff = threadDelay }> > -- 我们的效果栈> type MyEffects = ( Http ': Logging ': Random ': Suspend ': '[] )> > -- 我们的解释器> ioInterpreter :: EffectStack MyEffects IO> ioInterpreter = httpIO .:.日志IO .:.随机数 .:.暂停IO .:. EmptyEffect 希望现在您已经确信我们已经实现了我们的目标：我们可以在 Haskell 中针对效果进行编程，就像我们使用 Idris 和 PureScript 编程的同志一样（我说这完全是半开玩笑）。此外，我们可以提供任意效果堆栈并以我们想要的任何方式组合解释器（只要它们共享相同的 monad）。调查程序分析。 van Laarhoven Free Monad 只是一个函数，但我们可以为它提供一个为程序或静态分析构建的效果堆栈吗？