haskell - EachT でエラーを累積する

Question

私は、巨大な JSON ドキュメントを受け取り、それを断片的に解析し、断片ごとにエラーメッセージを報告することになっている Web API の次の小さなミニサンプルアプリケーションを持っています。

次のコードは、EitherT (およびエラーパッケージ) を使用した実際の例です。ただし、問題は、EitherT が最初に検出された Left で計算を中断し、最初に検出した「エラー」を返すことです。私が望むのは、生成可能なすべてのエラーメッセージのリストです。たとえば、最初の行がrunEitherT失敗した場合、それ以上できることはありません。しかし、2 行目が失敗した場合でも、2 行目にはデータの依存関係がないため、後続の行を実行しようとすることができます。したがって、理論的には、一度に多くの(必ずしもすべてではない) エラーメッセージを生成できます。

すべての計算を遅延して実行し、見つけたすべてのエラーメッセージを返すことは可能ですか?

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Data.ByteString.Lazy.Char8 (pack)
import Web.Scotty as S
import Network.Wai.Middleware.RequestLogger
import Data.Aeson
import Data.Aeson.Types
import Control.Lens hiding ((.=), (??))
import Data.Aeson.Lens
import qualified Data.Text as T
import Control.Error
import Control.Applicative
import qualified Data.HashMap.Strict as H
import Network.HTTP.Types

data TypeOne = TypeOne T.Text TypeTwo TypeThree
  deriving (Show)

data TypeTwo = TypeTwo Double
  deriving (Show)

data TypeThree = TypeThree Double
  deriving (Show)

main :: IO ()
main = scotty 3000 $ do
  middleware logStdoutDev

  post "/pdor" $ do
    api_key <- param "api_key"
    input   <- param "input"

    typeOne <- runEitherT $ do
      result       <- (decode (pack input) :: Maybe Value) ?? "Could not parse. Input JSON document is malformed"
      typeTwoObj   <- (result ^? key "typeTwo")            ?? "Could not find key typeTwo in JSON document."
      typeThreeObj <- (result ^? key "typeThree")          ?? "Could not find key typeThree in JSON document."
      name         <- (result ^? key "name" . _String)     ?? "Could not find key name in JSON document."
      typeTwo      <- hoistEither $ prependLeft "Error when parsing TypeTwo: " $ parseEither jsonTypeTwo typeTwoObj
      typeThree    <- hoistEither $ prependLeft "Error when parsing TypeThree: " $ parseEither jsonTypeThree typeThreeObj

      return $ TypeOne name typeTwo typeThree

    case typeOne of
      Left errorMsg -> do
        _ <- status badRequest400
        S.json $ object ["error" .= errorMsg]
      Right _ ->
        -- do something with the parsed Haskell type
        S.json $ object ["api_key" .= (api_key :: String), "message" .= ("success" :: String)]

prependLeft :: String -> Either String a -> Either String a
prependLeft msg (Left s) = Left (msg ++ s)
prependLeft _ x = x

jsonTypeTwo :: Value -> Parser TypeTwo
jsonTypeTwo (Object v) = TypeTwo <$> v .: "val"
jsonTypeTwo _ = fail $ "no data present for TypeTwo"

jsonTypeThree :: Value -> Parser TypeThree
jsonTypeThree (Object v) = TypeThree <$> v .: "val"
jsonTypeThree _ = fail $ "no data present for TypeThree"

誰かがいくつか持っている場合は、リファクタリングの提案にもオープンです。

score 9 · Accepted Answer

コメントで述べたように、エラーを蓄積するには少なくとも 2 つの方法があります。以下では、それらについて詳しく説明します。これらのインポートが必要になります:

import Control.Applicative
import Data.Monoid
import Data.These

`TheseT`モナド変換子

免責事項:は packageTheseTで呼び出さChronicleTれます。these

Thesedata typeの定義を見てみましょう:

data These a b = This a | That b | These a b

ここでandはデータ型のThisandにThat対応します。データコンストラクターは、たとえば蓄積機能を有効にするものです。これには、( type の) 結果と以前のエラーのコレクション ( type のコレクション)の両方が含まれます。LeftRightEitherTheseMonadba

既存のデータ型の定義を利用して、モナド変換子のようなTheseものを簡単に作成できます。ErrorT

newtype TheseT e m a = TheseT {
  runTheseT :: m (These e a)
}

TheseTMonadは、次の方法でのインスタンスです。

instance Functor m => Functor (TheseT e m) where
  fmap f (TheseT m) = TheseT (fmap (fmap f) m)

instance (Monoid e, Applicative m) => Applicative (TheseT e m) where
  pure x = TheseT (pure (pure x))
  TheseT f <*> TheseT x = TheseT (liftA2 (<*>) f x)

instance (Monoid e, Monad m) => Monad (TheseT e m) where
  return x = TheseT (return (return x))
  m >>= f = TheseT $ do
    t <- runTheseT m
    case t of
      This  e   -> return (This e)
      That    x -> runTheseT (f x)
      These _ x -> do
        t' <- runTheseT (f x)
        return (t >> t')  -- this is where errors get concatenated

`Applicative`たまる`ErrorT`

免責事項:このアプローチは、すでに newtype ラッパーで作業しているため、適応するのがいくらか簡単ですが、設定m (Either e a)でのみ機能しApplicativeます。

実際のコードがApplicativeインターフェイスのみを使用している場合は、そのインスタンスをErrorT変更することで回避できます。Applicative

トランスフォーマー以外のバージョンから始めましょう。

data Accum e a = ALeft e | ARight a

instance Functor (Accum e) where
  fmap f (ARight x) = ARight (f x)
  fmap _ (ALeft e)  = ALeft e

instance Monoid e => Applicative (Accum e) where
  pure = ARight
  ARight f <*> ARight x = ARight (f x)
  ALeft e  <*> ALeft e' = ALeft (e <> e')
  ALeft e  <*> _        = ALeft e
  _        <*> ALeft e  = ALeft e

定義するとき、両側がs であり、したがってを実行できるかどうか<*>を知っていることに注意してください。対応するインスタンスを定義しようとすると失敗します:ALeft<>Monad

instance Monoid e => Monad (Accum e) where
  return = ARight
  ALeft e >>= f = -- we can't apply f

したがって、私たちが持つ可能性のある唯一のMonadインスタンスはのそれですEither。しかし、 thenapはと同じではありません<*>:

Left a <*>  Left b  ≡  Left (a <> b)
Left a `ap` Left b  ≡  Left a

Accumしたがって、 asしか使用できませんApplicative。

Applicativeこれで、以下に基づいてトランスフォーマーを定義できますAccum。

newtype AccErrorT e m a = AccErrorT {
  runAccErrorT :: m (Accum e a)
}

instance (Functor m) => Functor (AccErrorT e m) where
  fmap f (AccErrorT m) = AccErrorT (fmap (fmap f) m)

instance (Monoid e, Applicative m) => Applicative (AccErrorT e m) where
  pure x = AccErrorT (pure (pure x))
  AccErrorT f <*> AccErrorT x = AccErrorT (liftA2 (<*>) f x)

であることに注意してAccErrorT e mくださいCompose m (Accum e)。

編集：

AccErrorAccValidationはin validationpackageとして知られています。

score 0 · Accepted Answer

実際には、これを矢印(Kleisli 変換子) としてコーディングできます。

newtype EitherAT x m a b = EitherAT { runEitherAT :: a -> m (Either x b) }

instance Monad m => Category EitherAT x m where
  id = EitherAT $ return . Right
  EitherAT a . EitherAT b
       = EitherAT $ \x -> do
              ax <- a x
              case ax of Right y -> b y
                         Left e  -> return $ Left e

instance (Monad m, Semigroup x) => Arrow EitherAT x m where
  arr f = EitherAT $ return . Right . f
  EitherAT a *** EitherAT b = EitherAT $ \(x,y) -> do
      ax <- a x
      by <- b y
      return $ case (ax,by) of
        (Right x',Right y') -> Right (x',y')
        (Left e  , Left f ) -> Left $ e <> f
        (Left e  , _      ) -> Left e
        (  _     , Left f ) ->        Left f
  first = (***id)

ただ、それは矢印の法則に違反します (のエラー情報を失わずにに書き直すa *** bことはできません)。しかし、すべてのを基本的に単なるデバッグデバイスと見なすと、それで問題ないと主張するかもしれません。first a >>> second baLeft

haskell - EachT でエラーを累積する

2 に答える 2

TheseTモナド変換子

ApplicativeたまるErrorT

Related

Reference

`TheseT`モナド変換子

`Applicative`たまる`ErrorT`