module Data.List.OnPartition (
onPartitionG ,
onPartition ,
onPartitionIndex ,
onRights ,
onOdds
)
where
import Control.Arrow ((***))
import Control.Monad.Fix (fix)
import Data.Bool (bool)
onPartition :: (a -> Bool)
-> ([a] -> [a])
-> [a]
-> [a]
onPartition s = fmap (map $ either id id) . onPartitionG (flip (bool Left Right) <*> s)
onPartitionIndex :: (Int -> Bool)
-> ([a] -> [a])
-> [a] -> [a]
onPartitionIndex s f = map snd . onPartition (s . fst) (uncurry zip . fmap f . unzip) . zip [0..]
onPartitionG :: (d -> Either c a)
-> ([a] -> [b])
-> [d] -> [Either c b]
onPartitionG s f xs = fst . fix $ part xs . f . snd where
part [] _ = ([],[])
part (x:xs) rt@(~(r:rs)) = case s x of
Right x -> ((Right r:) *** (x:) $ part xs rs)
Left y -> ((Left y:) *** id $ part xs rt)
onRights
:: ([a] -> [b])
-> [Either l a]
-> [Either l b]
onRights = onPartitionG id
onOdds :: ([a] -> [a])
-> [a]
-> [a]
onOdds = onPartitionIndex even