Work on a selection list datatype

src/ListHelp.hs

@@ -14,9 +14,14 @@ module ListHelp
     , merge
     , mergeBy
     , mergeOn
+
+    , takeWhileArb
+    , takeWhileArb'
+    , foldrWhileArb
     ) where
 import Data.List
 import Data.Ord
+import FoldableHelp
 
 loopPairs :: [a] -> [(a,a)]
 loopPairs (a:as) = snd $ foldr f (Just a,[]) (a:as)
@@ -85,3 +90,21 @@ mergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
 mergeOn f xs = map snd . mergeBy (comparing fst) (g xs) . g
   where
     g = map (\x -> let y = f x in y `seq` (y,x))
+
+-- | A generalised version of takeWhile
+takeWhileArb :: (a -> Bool) -> (a -> b -> a) -> a -> [b] -> [b]
+takeWhileArb _ _ _ [] = []
+takeWhileArb t f y (x:xs) = case f y x of
+    y' | t y' -> x : takeWhileArb t f y' xs
+       | otherwise -> []
+
+-- this may fuse better
+-- should do tests
+takeWhileArb' :: (a -> Bool) -> (a -> b -> a) -> a -> [b] -> [b]
+takeWhileArb' t f a0 = snd . ssfold (t . fst) (\(a0',xs) x -> (f a0' x,x:xs)) (a0,[])
+
+foldrWhileArb :: (b -> c -> c) -> c -> (a -> Bool) -> (a -> b -> a) -> a -> [b] -> c
+foldrWhileArb _ z _ _ _ [] = z
+foldrWhileArb h z t f y (x:xs) = case f y x of
+    y' | t y' -> h x $ foldrWhileArb h z t f y' xs
+       | otherwise -> h x z