haskell - 按常见错误类型类组合/绑定(bind)具有不同错误类型的 "Except"

Question

我有一些函数返回 Except类型(来自 transformers 包)具有不同的错误类型，但都实现了类 Show .如果出现错误，我只想打印消息。

组合/绑定(bind)它们的最佳方式是什么？

我可以为每个 fun* 转换错误类型之前(=<<) , 或者写一个 (=<<)接受所有可显示类型并将它们转换为 String 的包装器s(RankNTypes？)，但这感觉很难看。有没有更好的方法，使用类型系统，自动处理所有这些？

示例代码:

module Main where

import           Control.Monad.Trans.Except
import qualified Data.Text as T

type StrError = String
type TxtError = T.Text

funA :: String -> Except StrError String
funA = return

funB :: String -> Except TxtError T.Text
funB = return . T.pack

fun :: String -> IO ()
fun s = case runExcept (funB =<< funA s) of
            Left e  -> putStrLn $ show e
            Right _ -> return ()

main :: IO ()
main = fun "foo"

Answer 1

最简单的方法是创建一个新的 Exception 类型(但这确实需要 -XExistentialQuantification)可以显示的异常。

data Exception = forall e . Show e => Exception e

然后，要让您的代码通过编译，需要更改的只是类型签名。

funA :: String -> Except Exception String
funB :: String -> Except Exception T.Text

此外，每当您创建异常(上面的代码中没有示例)时，您现在需要将其包装在 Exception 构造函数中。

throwsA :: String -> Except Exception String
throwsA = throwE . Exception

throwsB :: T.Text -> Except Exception T.Text
throwsB = throwE . Exception

编辑 我鼓励您为异常创建新类型(使用适当的Show)，然后从Control.Exception 派生Exception .这是更多的开销，但如果您需要在异构异常类型之间来回切换，它可能会让您以后受益。这就是我会做的方式。

{-# LANGUAGE DeriveDataTypeable #-}
module Main where

import Data.Typeable
import Control.Exception
import Control.Monad.Trans.Except
import qualified Data.Text as T
import Control.Monad

newtype StrError = StrError String deriving (Show,Typeable)
newtype TxtError = TxtError T.Text deriving (Show,Typeable)

instance Exception StrError
instance Exception TxtError

toErr :: Exception e => Except e a -> Except SomeException a
toErr = mapExcept (either (Left . toException) Right)


funA :: String -> Except StrError String
funA = return

funB :: String -> Except TxtError T.Text
funB = return . T.pack

throwsA :: String -> Except StrError String
throwsA = throwE . StrError

throwsB :: T.Text -> Except TxtError T.Text
throwsB = throwE . TxtError


fun :: String -> IO ()
fun s = case runExcept $ (toErr . funA >=> toErr . funB) s of
            Left e  -> putStrLn $ displayException e
            Right _ -> return ()

main :: IO ()
main = fun "foo"