Broken parser: the commented out definition of "term" causes the parser to hang

Expr.hs

{-# LANGUAGE DeriveFunctor #-}
module Expr where

import Data.Monoid

data Expr a
  = Lit a
  | Neg (Expr a)
  | Add (Expr a) (Expr a)
  | Sub (Expr a) (Expr a)
  | Mul (Expr a) (Expr a)
  | Div (Expr a) (Expr a)
  deriving (Eq, Ord, Show, Read, Functor)

foldExpr
  :: (a -> r)
  -> (r -> r)
  -> (r -> r -> r)
  -> (r -> r -> r)
  -> (r -> r -> r)
  -> (r -> r -> r)
  -> Expr a
  -> r
foldExpr lit neg add sub mul div expr = case expr of
  Lit a     -> lit a
  Neg e     -> neg (k e)
  Add e1 e2 -> add (k e1) (k e2)
  Sub e1 e2 -> sub (k e1) (k e2)
  Mul e1 e2 -> mul (k e1) (k e2)
  Div e1 e2 -> div (k e1) (k e2)
  where k = foldExpr lit neg add sub mul div

eval :: Fractional a => Expr a -> a
eval = foldExpr id negate (+) (flip subtract) (*) (/)

-- Bit weird, ignores negates.
instance Foldable Expr where
  foldMap f = foldExpr f id (<>) (<>) (<>) (<>)

Main.hs

module Main where

import Data.Monoid
import Control.Monad
import Control.Applicative

import Text.Trifecta
import Text.Parser.Token as T
import Text.Parser.Token.Style as T
import Text.Parser.Expression as E
import Expr

number :: (Monad m, TokenParsing m) => m (Expr Double)
number = (Lit . either fromIntegral id) <$> T.integerOrDouble

------- Operator helpers ----------

-- | Parse a reserved operator (TODO: figure out what this does)
reservedOp name = T.reserve T.emptyOps name
prefix name fun       = Prefix (fun <$ reservedOp name)
binary name fun assoc = Infix (fun <$ reservedOp name) assoc

---------- Operators table -------------
table  :: (Monad m, TokenParsing m) => [[Operator m (Expr Double)]]
table =
  [ [ prefix "-" Neg ]
  , [ binary "*" Mul AssocLeft, binary "/" Div AssocLeft ]
  , [ binary "+" Add AssocLeft, binary "-" Sub AssocLeft ]
  ]

expr :: (Monad m, TokenParsing m) => m (Expr Double)
expr = buildExpressionParser table term <?> "expression"

term :: (Monad m, TokenParsing m) => m (Expr Double)
term = parens expr <|> number
-- This is broken- it causes the parser to hang.
-- term = expr <|> parens expr <|> number

-- Adding this as the "top level parser" works
top :: (Monad m, TokenParsing m) => m (Expr Double)
top = expr <|> term

main :: IO ()
main = do
  putStrLn "hi"
  print $ parseString top mempty "1 + 2 + (-3 * 4)"