import Control.Monad.Fix
import Control.Monad.Trans.State.Lazy
import Data.Bifunctor (first, second)

partitionR :: Traversable t => (a -> Bool) -> t a -> [b] -> [b] -> ([a], [a], t b)
partitionR p tr repl1 repl2 =
  let f x | p x = do
              modify (second (first (x:)))
              y <- gets (fst . fst)
              modify (first (first tail))
              pure (head y)
          | let = do
              modify (second (second (x:)))
              y <- gets (snd . fst)
              modify (first (second tail))
              pure (head y)
      (res, (_, (lt, lf))) = runState (traverse f tr) ((repl1, repl2), ([], []))
  in (reverse lt, reverse lf, res)

onPartitions :: (MonadFix m, Traversable t) =>
  (a -> Bool) -> ([a] -> m [b]) -> ([a] -> m [b]) -> t a -> m (t b)
onPartitions p t f xs = do
  (_, _, res) <- mfix $ \ ~(outt, outf, _) -> do
    let (pt, pf, res) = partitionR p xs outt outf
    (,,) <$> t pt <*> f pf <*> pure res
  pure res

pr :: Show a => a -> IO String
pr x = print x >> pure (show x)

main :: IO ()
main = print =<< onPartitions even (traverse pr) (traverse pr) [1..10]