Commit da9e2aff authored by Iustin Pop's avatar Iustin Pop
Browse files

Add two utility functions for handling Either lists



These two functions permit operating in bulk on only the Left or Right
values in the original list, then reassembling the list back in the
original order.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarMichele Tartara <mtartara@google.com>
parent 9c0a27d0
......@@ -53,11 +53,14 @@ module Ganeti.Utils
, trim
, defaultHead
, exitIfEmpty
, splitEithers
, recombineEithers
) where
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
import Data.Function (on)
import Data.List
import Control.Monad (foldM)
import Debug.Trace
......@@ -382,3 +385,44 @@ defaultHead _ (x:_) = x
exitIfEmpty :: String -> [a] -> IO a
exitIfEmpty _ (x:_) = return x
exitIfEmpty s [] = exitErr s
-- | 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
......@@ -32,6 +32,7 @@ import Test.QuickCheck hiding (Result)
import Test.HUnit
import Data.Char (isSpace)
import qualified Data.Either as Either
import Data.List
import System.Time
import qualified Text.JSON as J
......@@ -294,6 +295,29 @@ prop_trim (NonEmpty str) =
trim "" ==? ""
]
-- | 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]
-- | Test list for the Utils module.
testSuite "Utils"
[ 'prop_commaJoinSplit
......@@ -319,4 +343,5 @@ testSuite "Utils"
, 'prop_chompPrefix_last
, 'prop_chompPrefix_empty_string
, 'prop_chompPrefix_nothing
, 'prop_splitRecombineEithers
]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment