fb.hs

import Data.Array.IO
import Data.Maybe

solver :: IOArray Integer Integer -> IO [Integer]
solver arr = do
    idx <- getBounds arr
    out <- newArray idx Nothing
    solver' arr out idx

    map fromJust <$> getElems out

solver' :: IOArray Integer Integer -> IOArray Integer (Maybe Integer) -> (Integer, Integer) -> IO Integer
solver' arr accum (start, end) | start == end = readArray arr start
solver' arr accum (start, end) = do
    leftProduct <- recur leftBounds
    rightProduct <- recur rightBounds

    scaleBetween accum leftBounds rightProduct
    scaleBetween accum rightBounds leftProduct

    return (leftProduct * rightProduct)
    where
        middle = (start + end - 1) `div` 2
        leftBounds = (start, middle)
        rightBounds = (middle + 1, end)

        recur = solver' arr accum

scaleBetween :: IOArray Integer (Maybe Integer) -> (Integer, Integer) -> Integer -> IO ()
scaleBetween arr (start, end) scale = sequence_ [ performScaling x | x <- [start..end]]
    where
    performScaling :: Integer -> IO ()
    performScaling x = do
        curr <- readArray arr x
        case curr of
            Nothing -> writeArray arr x (Just scale)
            (Just v) -> writeArray arr x (Just $ v * scale)

main = newListArray (0, 3) [2, 3, 5, 10] >>= solver