From da9e2aff71d2bcc4d26055bb04cdb2e72482d60e Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Tue, 19 Feb 2013 14:26:48 +0100
Subject: [PATCH] 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: Iustin Pop <iustin@google.com>
Reviewed-by: Michele Tartara <mtartara@google.com>
---
src/Ganeti/Utils.hs | 44 ++++++++++++++++++++++++++++++++++++
test/hs/Test/Ganeti/Utils.hs | 25 ++++++++++++++++++++
2 files changed, 69 insertions(+)
diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs
index 0ff1984aa..b4a8c3cac 100644
--- a/src/Ganeti/Utils.hs
+++ b/src/Ganeti/Utils.hs
@@ -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
diff --git a/test/hs/Test/Ganeti/Utils.hs b/test/hs/Test/Ganeti/Utils.hs
index 28610ae2b..8436cd342 100644
--- a/test/hs/Test/Ganeti/Utils.hs
+++ b/test/hs/Test/Ganeti/Utils.hs
@@ -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
]
--
GitLab