import System.Random (randomRIO)
import Data.List (partition)
import Data.Monoid ((<>))

main :: IO [Int]
main = do

  
  ns <- knuthShuffle [1 .. 52]
  let (rs_, bs_, discards) = threeStacks (rb <$> ns)

  
  nSwap <- randomRIO (1, min (length rs_) (length bs_))
  let (rs, bs) = exchange nSwap rs_ bs_

  
  let rrs = filter ('R' ==) rs
  let bbs = filter ('B' ==) bs
  putStrLn $
    unlines
      [ "Discarded: " <> discards
      , "Swapped: " <> show nSwap
      , "Red pile: " <> rs
      , "Black pile: " <> bs
      , rrs <> " = Red cards in the red pile"
      , bbs <> " = Black cards in the black pile"
      , show $ length rrs == length bbs
      ]
  return ns


rb :: Int -> Char
rb n
  | even n = 'R'
  | otherwise = 'B'


threeStacks :: String -> (String, String, String)
threeStacks = go ([], [], [])
  where
    go tpl [] = tpl
    go (rs, bs, ds) [x] = (rs, bs, x: ds)
    go (rs, bs, ds) (x:y:xs)
      | 'R' == x = go (y: rs, bs, x: ds) xs
      | otherwise = go (rs, y: bs, x: ds) xs

exchange :: Int -> [a] -> [a] -> ([a], [a])
exchange n xs ys =
  let [xs_, ys_] = splitAt n <$> [xs, ys]
  in (fst ys_ <> snd xs_, fst xs_ <> snd ys_)



knuthShuffle :: [a] -> IO [a]
knuthShuffle xs = (foldr swapElems xs . zip [1 ..]) <$> randoms (length xs)

randoms :: Int -> IO [Int]
randoms x = traverse (randomRIO . (,) 0) [1 .. (pred x)]

swapElems :: (Int, Int) -> [a] -> [a]
swapElems (i, j) xs
  | i == j = xs
  | otherwise = replaceAt j (xs !! i) $ replaceAt i (xs !! j) xs

replaceAt :: Int -> a -> [a] -> [a]
replaceAt i c l =
  let (a, b) = splitAt i l
  in a ++ c: drop 1 b