Synnefo » snf-ganeti

  , splitEithers

  , recombineEithers

import Control.Monad (foldM)

-- | Split an 'Either' list into two separate lists (containing the

-- 'Left' and 'Right' elements, plus a \"trail\" list that allows

-- recombination later.

--

-- This is splitter; for recombination, look at 'recombineEithers'.

-- The sum of \"left\" and \"right\" lists should be equal to the

-- original list length, and the trail list should be the same length

-- as well. The entries in the resulting lists are reversed in

-- comparison with the original list.

splitEithers :: [Either a b] -> ([a], [b], [Bool])

splitEithers = foldl' splitter ([], [], [])

  where splitter (l, r, t) e =

          case e of

            Left  v -> (v:l, r, False:t)

            Right v -> (l, v:r, True:t)

-- | Recombines two \"left\" and \"right\" lists using a \"trail\"

-- list into a single 'Either' list.

--

-- This is the counterpart to 'splitEithers'. It does the opposite

-- transformation, and the output list will be the reverse of the

-- input lists. Since 'splitEithers' also reverses the lists, calling

-- these together will result in the original list.

--

-- Mismatches in the structure of the lists (e.g. inconsistent

-- lengths) are represented via 'Bad'; normally this function should

-- not fail, if lists are passed as generated by 'splitEithers'.

recombineEithers :: (Show a, Show b) =>

                    [a] -> [b] -> [Bool] -> Result [Either a b]

recombineEithers lefts rights trail =

  foldM recombiner ([], lefts, rights) trail >>= checker

    where checker (eithers, [], []) = Ok eithers

          checker (_, lefts', rights') =

            Bad $ "Inconsistent results after recombination, l'=" ++

                show lefts' ++ ", r'=" ++ show rights'

          recombiner (es, l:ls, rs) False = Ok (Left l:es,  ls, rs)

          recombiner (es, ls, r:rs) True  = Ok (Right r:es, ls, rs)

          recombiner (_,  ls, rs) t = Bad $ "Inconsistent trail log: l=" ++

                                      show ls ++ ", r=" ++ show rs ++ ",t=" ++

                                      show t

import qualified Data.Either as Either

-- | Tests 'splitEithers' and 'recombineEithers'.

prop_splitRecombineEithers :: [Either Int Int] -> Property

prop_splitRecombineEithers es =

  conjoin

  [ printTestCase "only lefts are mapped correctly" $

    splitEithers (map Left lefts) ==? (reverse lefts, emptylist, falses)

  , printTestCase "only rights are mapped correctly" $

    splitEithers (map Right rights) ==? (emptylist, reverse rights, trues)

  , printTestCase "recombination is no-op" $

    recombineEithers splitleft splitright trail ==? Ok es

  , printTestCase "fail on too long lefts" $

    isBad (recombineEithers (0:splitleft) splitright trail)

  , printTestCase "fail on too long rights" $

    isBad (recombineEithers splitleft (0:splitright) trail)

  , printTestCase "fail on too long trail" $

    isBad (recombineEithers splitleft splitright (True:trail))

  ]

  where (lefts, rights) = Either.partitionEithers es

        falses = map (const False) lefts

        trues = map (const True) rights

        (splitleft, splitright, trail) = splitEithers es

        emptylist = []::[Int]

            , 'prop_splitRecombineEithers