Infinite recursion due to implementation of Functor via monadic bind

Main.hs

module Main where
import Data.Char (ord, toLower)

newtype PrsE a = PrsE { runPrsE :: String -> Either String (a, String) }

satisfyE :: (Char -> Bool) -> PrsE Char
satisfyE f = PrsE g
  where
    g "" = Left "unexpected end of input"
    g (c:cs)
      | f c = Right (c,cs)
      | otherwise = Left ("unexpected " <> [c])

charE :: Char -> PrsE Char
charE c = satisfyE (== c)


-- (Option 1)
instance Functor PrsE where
  fmap f (PrsE g) = PrsE fun
    where
      fun s = 
        case g s of
          Left str -> Left str
          Right (a, str) -> Right (f a, str)

-- (Option 2)
-- instance Functor PrsE where
--   fmap f x = do x' <- x; return (f x')

instance Applicative PrsE where
  pure = return
  f <*> x = do
    f' <- f
    x' <- x
    return (f' x')

instance Monad PrsE where
  PrsE f >>= y = PrsE fun
    where
      fun s =
        case f s of
          Left str -> Left str
          Right (a, s1) -> runPrsE (y a) s1

main :: IO ()
main = print $ runPrsE (ord <$> charE 'A') "A"