我试图写some EitherT monad transformer, as suggested from real world haskell chapter 18。
newtype EitherT e m a = EitherT {
runEitherT :: m (Either e a)
}
我的EitherT的{{1}}类型将Left error和Right result，并且会在{{1}处停止时绑定所有产生Either值的计算值，将它们保持为错误。
我的代码在下面（抱歉为命令式）：
Right我认为为left转换器编写bindET :: (Monad m) => (EitherT e m a) -> (a -> EitherT e m b) -> (EitherT e m b)
x `bindET` f = EitherT $ do
mx <- runEitherT x
case mx of
Right success -> runEitherT (f success)
Left error -> return (Left error)
instance (Monad m) => Monad (EitherT e m) where
return a = EitherT $ return (Right a)
(>>=) = bindET
fail e = EitherT $ return (Left e)
个实例非常简单，但是当我将代码加载到ghci中时，我得到了这个神秘的错误消息：
Monad似乎EitherT函数已修复以EitherT.hs:30:18:
Could not deduce (e ~ [Char])
from the context (Monad m)
bound by the instance declaration at EitherT.hs:27:10-41
`e' is a rigid type variable bound by
the instance declaration at EitherT.hs:27:10
Expected type: EitherT e m a
Actual type: EitherT String m a
In the expression: EitherT $ return (Left e)
In an equation for `fail': fail e = EitherT $ return (Left e)
In the instance declaration for `Monad (EitherT e m)'
Failed, modules loaded: none.
作为参数 - 好吧，如果是这样，那么我的fail将是String并且所有EitherT e m a值为EitherT String m a。但是我希望Left monad将任何类型的值作为Left String来表示计算中的错误。我怎样才能做到这一点？
答案 0 :(得分：1)
EitherT也是MonadError的一个实例，为您提供throwError :: e -> EitherT e m a。如果您出于教育原因实施自己的EitherT，可以在上面的链接中查找MonadError，并找出如何使自己的ErrorT类型也成为该实例。
fail通常被认为是一个糟糕的界面，因为a，它与你注意到的String和b绑定，因为它在Monad，迫使monad实现它，即使它没有意义。
答案 1 :(得分：0)
如果您想以这种方式使用fail，可以将monad定义为EitherT String m：
instance (Monad m) => Monad (EitherT String m) where
-- ...
这并不像它看起来那么无用，因为错误通常都是字符串。
这样做的好处是可以处理模式匹配失败。如果您想（例如）调用需要返回Just
do
Just a <- lift getTheThing
lift (print a)
缺点是您收到的错误消息"pattern match failure in ..."不是"couldn't get the thing, try restarting the server"，而是类似throwError。
如果您只想在失败时手动调用某些内容，请使用像Cactus建议的SwaggerDocsConfig configuration;
.....
configuration.DocumentFilter<PolymorphismDocumentFilter<YourBaseClass>>();
configuration.SchemaFilter<PolymorphismSchemaFilter<YourBaseClass>>();
.....
public class PolymorphismSchemaFilter<T> : ISchemaFilter
{
private readonly Lazy<HashSet<Type>> derivedTypes = new Lazy<HashSet<Type>>(Init);
private static HashSet<Type> Init()
{
var abstractType = typeof(T);
var dTypes = abstractType.Assembly
.GetTypes()
.Where(x => abstractType != x && abstractType.IsAssignableFrom(x));
var result = new HashSet<Type>();
foreach (var item in dTypes)
result.Add(item);
return result;
}
public void Apply(Schema schema, SchemaRegistry schemaRegistry, Type type)
{
if (!derivedTypes.Value.Contains(type)) return;
var clonedSchema = new Schema
{
properties = schema.properties,
type = schema.type,
required = schema.required
};
//schemaRegistry.Definitions[typeof(T).Name]; does not work correctly in SwashBuckle
var parentSchema = new Schema { @ref = "#/definitions/" + typeof(T).Name };
schema.allOf = new List<Schema> { parentSchema, clonedSchema };
//reset properties for they are included in allOf, should be null but code does not handle it
schema.properties = new Dictionary<string, Schema>();
}
}
public class PolymorphismDocumentFilter<T> : IDocumentFilter
{
public void Apply(SwaggerDocument swaggerDoc, SchemaRegistry schemaRegistry, System.Web.Http.Description.IApiExplorer apiExplorer)
{
RegisterSubClasses(schemaRegistry, typeof(T));
}
private static void RegisterSubClasses(SchemaRegistry schemaRegistry, Type abstractType)
{
const string discriminatorName = "discriminator";
var parentSchema = schemaRegistry.Definitions[SchemaIdProvider.GetSchemaId(abstractType)];
//set up a discriminator property (it must be required)
parentSchema.discriminator = discriminatorName;
parentSchema.required = new List<string> { discriminatorName };
if (!parentSchema.properties.ContainsKey(discriminatorName))
parentSchema.properties.Add(discriminatorName, new Schema { type = "string" });
//register all subclasses
var derivedTypes = abstractType.Assembly
.GetTypes()
.Where(x => abstractType != x && abstractType.IsAssignableFrom(x));
foreach (var item in derivedTypes)
schemaRegistry.GetOrRegister(item);
}
}
。