Monoidal tree interview in Haskell

I was working on the following interview question:

Given an array of integers, return a new array such that each element at index i of the new array is the product of all the numbers in the original array except the one at i.

For example, if our input was [1, 2, 3, 4, 5], the expected output would be [120, 60, 40, 30, 24]. If our input was [3, 2, 1], the expected output would be [2, 3, 6].

Follow-up: what if you can't use division?

I decided to do the followup question in Haskell:

{-# LANGUAGE ViewPatterns, PatternSynonyms #-}
import Control.Monad (join)
import Control.Arrow ((***))
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Monoid (Product(..), getProduct)

mapTuple = join (***)

pattern Empty   <- (Seq.viewl -> Seq.EmptyL)
pattern x :< xs <- (Seq.viewl -> x Seq.:< xs)

data Tree a = Leaf a | Branch a (Tree a, Tree a)
label :: Tree a -> a
label (Leaf a) = a
label (Branch a _) = a

{- Create a complete binary tree, such that each subtree contains the concat of all
 - elements under it. -}
makeTree :: Monoid a => Seq a -> Tree a
makeTree Empty = undefined
makeTree (label :< Empty) = Leaf label
makeTree s =
  let midpoint = Seq.length s `div` 2 in
  let subseq = Seq.splitAt midpoint s in
  let subtrees = mapTuple makeTree subseq in
  let subtreeLabels = mapTuple label subtrees in
  let label = uncurry mappend subtreeLabels in
  Branch label subtrees

{- Zippers. -}
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a)
type Breadcrumbs a = [Crumb a]
type Zipper a = (Tree a, Breadcrumbs a)

goLeft :: Zipper a -> Zipper a
goLeft (Branch x (l, r), bs) = (l, LeftCrumb x r:bs)
goLeft (Leaf _, _) = error "Nothing to go left into"

goRight :: Zipper a -> Zipper a
goRight (Branch x (l, r), bs) = (r, RightCrumb x l:bs)  
goRight (Leaf _, _) = error "Nothing to go right into"

-- Concat of all elements except the one corresponding to the given crumbs
concatAllExcept :: Monoid a => Breadcrumbs a -> a
concatAllExcept = concatAllExceptRev . reverse where
  concatAllExceptRev [] = mempty
  concatAllExceptRev ((LeftCrumb _ subtree) : xs) =
    concatAllExceptRev xs <> label subtree
  concatAllExceptRev ((RightCrumb _ subtree) : xs) =
    label subtree <> concatAllExceptRev xs

-- Return a list of zippers pointing to the leafs of the tree
dfsList :: Tree a -> [Zipper a]
dfsList t =
  reverse $ dfsListHelper (t, []) [] where
    dfsListHelper zipper@(Leaf _, _) accum = zipper : accum
    dfsListHelper zipper@(Branch _ _, _) accum =
      -- Since this is a Branch node, both [goLeft] and [goRight] will work.
      let l = goLeft zipper
          r = goRight zipper in
      dfsListHelper r (dfsListHelper l accum)

{- Produces a list such that the ith element is the concat of all elements in the
 - original list, excluding the ith element. -}
concatAllExceptEach :: Monoid a => [a] -> [a]
concatAllExceptEach = map (concatAllExcept . snd) . dfsList . makeTree . Seq.fromList

answer :: [Integer] -> [Integer]
answer = map getProduct . concatAllExceptEach . fmap Product

main = do
  print $ answer [3, 10, 33, 4, 31, 31, 1, 7]
  print $ answer [1, 2, 3, 4, 5]
  print $ concatAllExceptEach ["A", "B", "C", "D"]

Algorithm runs in Θ(n log n) which I believe is optimal. New to Haskell so all feedback welcome.