module Main where
main :: IO ()
main = let
  k = fromIntegral . fst $ multiplesOfN !! pred 10
  p = funcF k
  q = funcG p
  r = funcH q
    in putStrLn . show $ (p, q, r)

multiplesOfN :: [(Integer, Integer)]
multiplesOfN = filter p . zip [1..] . map funcF $ [1..]
  where
    p (n, f)
      | f == 0    = False
      | otherwise = f `mod` n == 0

funcF = (!!) fibl
  where fibl = 3:0:2:zipWith (+) fibl (tail fibl)

funcG = maximum . primeFactors
funcH n = sum . map snd $ takeWhile (\(_, p) -> p <= n) pthPrimes

factors :: [Integer] -> Integer -> [Integer]
factors qs@(p:ps) n
  | n <= 1 = []
  | m == 0 = p : factors qs d
  | otherwise = factors ps n
  where (d,m) = n `divMod` p

primeFactors :: Integer -> [Integer]
primeFactors = factors primes

isPrime :: Integer -> Bool
isPrime n | n > 1     = primeFactors n == [n]
          | otherwise = False

pthPrimes = filter (isPrime . fst) $ zip [1..] primes

primes :: [Integer]
primes = 2 : sieve [3..] primes
  where
    sieve xs (p:ps)
      | q <- p*p,
      (h,t) <- span (< q) xs =
        h ++ sieve (t `minus` [q, q+p..]) ps

minus (x:xs) (y:ys) = case (compare x y) of
            LT -> x : minus  xs  (y:ys)
            EQ ->     minus  xs     ys
            GT ->     minus (x:xs)  ys
minus  xs     _     = xs