SumProdDiff1000.hs

import qualified Data.List.NonEmpty as NE
import Data.List (sortOn, sort)
import qualified Data.Set as Set
import Data.Function

uniqueFactorsAndSums :: Set.Set (Int, Int)
uniqueFactorsAndSums =
    [(x * y, x + y) | x <- [1..1000], y <- [x..1000]]
        & NE.groupAllWith fst
        & filter ((== 1) . length)
        & map NE.head
        & Set.fromList

uniqueSums :: Set.Set Int
uniqueFactors :: Set.Set Int
(uniqueFactors, uniqueSums) = (Set.fromList p, Set.fromList s)
    where
    (p, s) = unzip (Set.toList uniqueFactorsAndSums)

uniqueFactorsAfterBob :: Set.Set Int
uniqueFactorsAfterBob =
    [x * y | x <- [1..1000], y <- [x..1000], not ((x + y) `Set.member` uniqueSums)]
        & NE.groupAllWith id
        & filter ((== 1) . length)
        & map NE.head
        & Set.fromList

uniqueSumsAfterAlice :: Set.Set (Int, (Int, Int))
uniqueSumsAfterAlice =
    [(x + y, (x, y))
        | x <- [1..1000], y <- [x..1000]
        , not ((x + y) `Set.member` uniqueSums)
        , (x * y) `Set.member` uniqueFactorsAfterBob ]
        & NE.groupAllWith fst
        & filter ((== 1) . length)
        & map NE.head
        & Set.fromList

afterAliceAndBob :: Set.Set (Int, Int)
afterAliceAndBob = Set.map snd uniqueSumsAfterAlice

charlie =
    [(y - x, [x, y]) | (x, y) <- Set.toList afterAliceAndBob]
        & NE.groupAllWith fst
        & fmap (\g -> (fst (NE.head g), sort $ foldMap snd g))