Eitherモナドの使い道 部分的な失敗を全体的な失敗とする計算(2)

※この記事のMaybe編はこちら

idと名前のデータベースと、順位とidのデータベースからなる、下記のようなフレームワークを考えてみよう。

2位の名前を取り出すには、idFromRank で 2位のidを取り出し、その id を nameFromId に渡して名前を得るものとする。
idFromRank も nameFromId も要求された順位やidのデータがなければ Left に評価されるものとする。

type Err = String
type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Either Err ID
idFromRank db rk =
  case lookup rk db of
    Nothing -> Left $ "id of rank " ++ (show rk) ++ " was not found."
    Just id -> Right id

nameFromId :: NameDB -> ID -> Either Err Name
nameFromId db id =
  case lookup id db of
    Nothing   -> Left $ "name of id " ++ (show id) ++ " was not found."
    Just name -> Right name

このフレームワークを使って、上位3位の名前を取得する関数を作成してみよう。
ポイントは、idFromRank も nameFromId も Left に評価されることがあるため、この関数もEither型に評価されるものとし、1位から3位までのidがすべて存在し、それらの名前がすべて存在する場合のみRightに評価され、それ以外のときはLeftに評価されるようにすることだ。

下記のように呼び出されるようになればよいだろう。

main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]

式を使ったプログラミングで素直に記述する場合、筆者の能力では下記の記述が限界である。
これはどう考えても地獄である。我々が関数プログラミングに求めていたものはこんなものではなかったはずだ。

topThree :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThree rdb ndb =
  let eitherId1 = idFromRank rdb 1
  in
   if isLeft eitherId1 then Left $ fromLeft eitherId1
   else
     let eitherName1 = nameFromId ndb $ fromRight eitherId1
     in
      if isLeft eitherName1 then Left $ fromLeft eitherName1
      else
        let eitherId2 = idFromRank rdb 2
        in
         if isLeft eitherId2 then Left $ fromLeft eitherId2
         else
           let eitherName2 = nameFromId ndb $ fromRight eitherId2
           in
            if isLeft eitherName2 then Left $ fromLeft eitherName2
            else
              let eitherId3 = idFromRank rdb 3
              in
               if isLeft eitherId3 then Left $ fromLeft eitherId3
               else
                 let eitherName3 = nameFromId ndb $ fromRight eitherId3
                 in
                  if isLeft eitherName3 then Left $ fromLeft eitherName3
                  else Right (
                    fromRight eitherName1,
                    fromRight eitherName2,
                    fromRight eitherName3
                    )
  where
    fromLeft (Left x) = x 
    fromRight (Right x) = x

Haskell には case 文があるので、効果的に使えば下記のように改善することができる。
しかし case 文の入れ子も本質的には地獄である。こんなことなら手続き型言語を使えばよいのではないか。

topThreeC :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Left e -> Left e
    Right id1 -> case nameFromId ndb id1 of
      Left e -> Left e
      Right n1 -> case idFromRank rdb 2 of
        Left e -> Left e
        Right id2 -> case nameFromId ndb id2 of
          Left e -> Left e
          Right n2 -> case idFromRank rdb 3 of
            Left e -> Left e
            Right id3 -> case nameFromId ndb id3 of
              Left e -> Left e
              Right n3 -> Right (n1,n2,n3)

そこで Eitherモナド登場。
Either型のモナドとしての性質を使うと、上記とまったく同じ意味の関数を下記の内容だけで記述することができる。
モナドとしてのEither型には、失敗するかもしれない計算どうしを組み合わせるときは、一部でも失敗したらすべてが失敗したことにする
という性質が最初から組み込まれているためである。

topThreeM :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)

全部のせておく。

import Data.Either (isLeft)

type Err = String
type ID = Int
type Rank = Int
type Name = String
type RankDB = [(Rank,ID)]
type NameDB = [(ID,Name)]

idFromRank :: RankDB -> Rank -> Either Err ID
idFromRank db rk =
  case lookup rk db of
    Nothing -> Left $ "id of rank " ++ (show rk) ++ " was not found."
    Just id -> Right id

nameFromId :: NameDB -> ID -> Either Err Name
nameFromId db id =
  case lookup id db of
    Nothing   -> Left $ "name of id " ++ (show id) ++ " was not found."
    Just name -> Right name




topThree :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThree rdb ndb =
  let eitherId1 = idFromRank rdb 1
  in
   if isLeft eitherId1 then Left $ fromLeft eitherId1
   else
     let eitherName1 = nameFromId ndb $ fromRight eitherId1
     in
      if isLeft eitherName1 then Left $ fromLeft eitherName1
      else
        let eitherId2 = idFromRank rdb 2
        in
         if isLeft eitherId2 then Left $ fromLeft eitherId2
         else
           let eitherName2 = nameFromId ndb $ fromRight eitherId2
           in
            if isLeft eitherName2 then Left $ fromLeft eitherName2
            else
              let eitherId3 = idFromRank rdb 3
              in
               if isLeft eitherId3 then Left $ fromLeft eitherId3
               else
                 let eitherName3 = nameFromId ndb $ fromRight eitherId3
                 in
                  if isLeft eitherName3 then Left $ fromLeft eitherName3
                  else Right (
                    fromRight eitherName1,
                    fromRight eitherName2,
                    fromRight eitherName3
                    )
  where
    fromLeft (Left x) = x 
    fromRight (Right x) = x



topThreeC :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeC rdb ndb =
  case idFromRank rdb 1 of
    Left e -> Left e
    Right id1 -> case nameFromId ndb id1 of
      Left e -> Left e
      Right n1 -> case idFromRank rdb 2 of
        Left e -> Left e
        Right id2 -> case nameFromId ndb id2 of
          Left e -> Left e
          Right n2 -> case idFromRank rdb 3 of
            Left e -> Left e
            Right id3 -> case nameFromId ndb id3 of
              Left e -> Left e
              Right n3 -> Right (n1,n2,n3)



topThreeM :: RankDB -> NameDB -> Either Err (Name,Name,Name)
topThreeM rdb ndb = do

  id <- idFromRank rdb 1
  n1 <- nameFromId ndb id

  id <- idFromRank rdb 2
  n2 <- nameFromId ndb id
    
  id <- idFromRank rdb 3
  n3 <- nameFromId ndb id

  return (n1,n2,n3)




main = do
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThree [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeC [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(4,102),(3,103)] [(101,"1st"),(102,"2nd"),(103,"3rd")]
  print $ topThreeM [(1,101),(2,102),(3,103)] [(101,"1st"),(104,"4th"),(103,"3rd")]