diff --git a/src/MA/FunctorExpression/Parser.hs b/src/MA/FunctorExpression/Parser.hs
index e30549165fde8e273df963d97390926bbd1477e2..b786df081a6c47a27cc3d2ffe148943cccbdba04 100644
--- a/src/MA/FunctorExpression/Parser.hs
+++ b/src/MA/FunctorExpression/Parser.hs
@@ -1,6 +1,11 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module MA.FunctorExpression.Parser
   ( FunctorParser(..)
+  , prefix
+  , postfix
+  , infixR
   , transParser
   , Precedence(..)
   , functorsParser
@@ -8,6 +13,7 @@ module MA.FunctorExpression.Parser
   ) where
 
 import           Data.List
+import           Control.Monad
 
 import           Text.Megaparsec
 import qualified Text.Megaparsec.Expr as Expr
@@ -18,60 +24,51 @@ import           MA.Parser.Lexer
 import           MA.Parser.Types
 
 data FunctorParser f where
-  Prefix :: (forall a m. ParserT m (a -> f a)) -> FunctorParser f
-  Postfix :: (forall a m. ParserT m (a -> f a)) -> FunctorParser f
-  InfixN :: (forall  a m. ParserT m (a -> a -> f a )) -> FunctorParser f
-  InfixL :: (forall  a m. ParserT m (a -> a -> f a )) -> FunctorParser f
-  InfixR :: (forall  a m. ParserT m (a -> a -> f a )) -> FunctorParser f
+  FunctorParser :: (forall a m. MonadParser m => m a -> m (Either a (f a))) -> FunctorParser f
+
+prefix :: (forall a m. MonadParser m => m (a -> f a)) -> FunctorParser f
+prefix parser = FunctorParser $ \inner -> do
+  (parser >>= \f -> Right . f <$> inner) <|> (Left <$> inner)
+
+postfix :: (forall a m. MonadParser m => m (a -> f a)) -> FunctorParser f
+postfix parser = FunctorParser $ \inner -> do
+  i <- inner
+  (parser >>= \f -> return (Right (f i))) <|> return (Left i)
+
+infixR :: (forall a m. MonadParser m => m (a -> a -> f a)) -> FunctorParser f
+infixR parser = FunctorParser $ \inner -> do
+  l <- inner
+  let p = do
+        f <- parser
+        r <- inner
+        return (Right (f l r))
+
+  p <|> return (Left l)
 
 transParser :: (forall a. f a -> g a) -> FunctorParser f -> FunctorParser g
-transParser natTrans (Prefix p) = Prefix (fmap natTrans <$> p)
-transParser natTrans (Postfix p) = Postfix (fmap natTrans <$> p)
-transParser natTrans (InfixN p) = InfixN ((\f a b -> natTrans (f a b)) <$> p)
-transParser natTrans (InfixL p) = InfixL ((\f a b -> natTrans (f a b)) <$> p)
-transParser natTrans (InfixR p) = InfixR ((\f a b -> natTrans (f a b)) <$> p)
+transParser natTrans (FunctorParser p) =
+  -- yeah! Tripple fmap
+  FunctorParser (fmap (fmap (fmap natTrans))  p)
 
 newtype Precedence = Precedence Int
   deriving (Num, Bounded, Enum, Integral, Real, Ord, Eq, Show)
 
-functorsParser :: [[FunctorParser f]] -> ParserT m (FunctorExpression f Precedence)
-functorsParser functors =
-  try spaceConsumer *> Expr.makeExprParser term (makeOpTable functors)
-  >>= checkForFunction
+functorsParser :: forall f m. [FunctorParser f] -> ParserT m (FunctorExpression f Precedence)
+functorsParser functors = try spaceConsumer *> parseLevel (zip (reverse functors) [1..]) >>= checkForFunctor
   where
-    term = parens (functorsParser functors) <|> (symbol "X" >> return Variable)
+    parseLevel :: [(FunctorParser f, Precedence)] -> ParserT m (FunctorExpression f Precedence)
+    parseLevel ((FunctorParser f, i):functors) = f (parseLevel functors) >>= \case
+      Left a -> return a
+      Right fa -> return (Functor i fa)
+    parseLevel [] = variable <|> parens (functorsParser functors)
 
-checkForFunction ::
-     FunctorExpression f Precedence -> ParserT m (FunctorExpression f Precedence)
-checkForFunction (Functor a b) = return (Functor a b)
-checkForFunction Variable = fail "Functor expression needs at least one function symbol"
-
-makeOpTable ::
-     [[FunctorParser f]]
-  -> [[Expr.Operator (ParserT m) (FunctorExpression f Precedence)]]
-makeOpTable table =
-  let tableWithPrecedence = zip (reverse [1 .. genericLength table]) table
-   in map
-        (\(precedence, functors) -> map (funcToOp precedence) functors)
-        tableWithPrecedence
-  where
-    funcToOp ::
-         Precedence
-      -> FunctorParser f
-      -> Expr.Operator (ParserT m) (FunctorExpression f Precedence)
-    funcToOp precedence funcParser =
-      case funcParser of
-        Prefix p -> Expr.Prefix ((Functor precedence .) <$> p)
-        Postfix p -> Expr.Postfix ((Functor precedence .) <$> p)
-        InfixN p -> Expr.InfixN (mkInfix precedence <$> p)
-        InfixL p -> Expr.InfixL (mkInfix precedence <$> p)
-        InfixR p -> Expr.InfixR (mkInfix precedence <$> p)
+    variable :: ParserT m (FunctorExpression f Precedence)
+    variable = symbol "X" >> return Variable
 
-    mkInfix precedence f a b = Functor precedence (f a b)
+checkForFunctor ::
+     FunctorExpression f Precedence -> ParserT m (FunctorExpression f Precedence)
+checkForFunctor (Functor a b) = return (Functor a b)
+checkForFunctor Variable = fail "Functor expression needs at least one function symbol"
 
-parseFunctorExpression ::
-     [[FunctorParser f]]
-  -> String
-  -> Text
-  -> Either ParseErr (FunctorExpression f Precedence)
-parseFunctorExpression functors = parse (functorsParser functors)
+parseFunctorExpression :: [[FunctorParser f]] -> String -> Text -> Either ParseErr (FunctorExpression f Precedence)
+parseFunctorExpression = parse . functorsParser . concat
diff --git a/src/MA/Functors/Bag.hs b/src/MA/Functors/Bag.hs
index bce4dc6c75313b0ba5d4a7843faab6e164b569fb..55cc667a1c60f6487dc4908d0cfe8815c9c89e7e 100644
--- a/src/MA/Functors/Bag.hs
+++ b/src/MA/Functors/Bag.hs
@@ -32,7 +32,7 @@ newtype Bag a = Bag a
   deriving (Functor,Foldable,Traversable)
 
 bag :: FunctorParser Bag
-bag = Prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag)
+bag = prefix ((L.symbol "B" <|> L.symbol "Ɓ") >> pure Bag)
 
 type instance Label Bag = Label (MonoidValued Int)
 type instance Weight Bag = Weight (MonoidValued Int)
diff --git a/src/MA/Functors/Distribution.hs b/src/MA/Functors/Distribution.hs
index f748a8a4d44ecbefda3f599b2f1870ed7fffcc96..46b315762213eb0dc30e5931dc0ff9497a532767 100644
--- a/src/MA/Functors/Distribution.hs
+++ b/src/MA/Functors/Distribution.hs
@@ -25,7 +25,7 @@ newtype Distribution x = Distribution x
   deriving (Functor, Foldable, Traversable)
 
 distribution :: FunctorParser Distribution
-distribution = Prefix ((L.symbol "D" <|> L.symbol "Ɗ") >> pure Distribution)
+distribution = prefix ((L.symbol "D" <|> L.symbol "Ɗ") >> pure Distribution)
 
 type instance Label Distribution = Label (MonoidValued Double)
 type instance Weight Distribution = Weight (MonoidValued Double)
diff --git a/src/MA/Functors/FixedProduct.hs b/src/MA/Functors/FixedProduct.hs
index 6f6126e7af1ad227babec1d268a01a635704717c..98d464912989186f47efd39509faeea2462bc62b 100644
--- a/src/MA/Functors/FixedProduct.hs
+++ b/src/MA/Functors/FixedProduct.hs
@@ -23,7 +23,7 @@ data FixedProduct a = FixedProduct (Vector Text) a
   deriving (Show,Functor,Foldable,Traversable)
 
 fixedproduct :: FunctorParser FixedProduct
-fixedproduct = Prefix $ do
+fixedproduct = prefix $ do
   labels <- L.braces (L.name `sepBy` L.comma)
   void $ L.symbol "x"
   return (FixedProduct (V.fromList labels))
diff --git a/src/MA/Functors/MonoidValued.hs b/src/MA/Functors/MonoidValued.hs
index cd9b5a324d3033a479facd04ccfdc074c956754c..f30903893ffc98636f16e8e9d081d7feae62fa8c 100644
--- a/src/MA/Functors/MonoidValued.hs
+++ b/src/MA/Functors/MonoidValued.hs
@@ -35,11 +35,11 @@ deriving instance Foldable (MonoidValued m)
 deriving instance Traversable (MonoidValued m)
 
 intValued :: FunctorParser (MonoidValued Int)
-intValued = Prefix
+intValued = prefix
   ((L.symbol "Z" <|> L.symbol "ℤ") >> L.symbol "^" >> pure IntValued)
 
 realValued :: FunctorParser (MonoidValued Double)
-realValued = Prefix
+realValued = prefix
   ((L.symbol "R" <|> L.symbol "ℝ") >> L.symbol "^" >> pure RealValued)
 
 type instance Label (MonoidValued m) = m
diff --git a/src/MA/Functors/Powerset.hs b/src/MA/Functors/Powerset.hs
index 3ef7950620e31de37b07c9803b428e4f5920d525..fb1ed9a7d051fa8e51b54b3b6670bb2936f995ce 100644
--- a/src/MA/Functors/Powerset.hs
+++ b/src/MA/Functors/Powerset.hs
@@ -18,7 +18,7 @@ newtype Powerset a = Powerset a
   deriving (Show,Functor,Foldable,Traversable)
 
 powerset :: FunctorParser Powerset
-powerset = Prefix ((L.symbol "P" <|> L.symbol "Ƥ") >> pure Powerset)
+powerset = prefix ((L.symbol "P" <|> L.symbol "Ƥ") >> pure Powerset)
 
 -- | No edge labels
 type instance Label Powerset = ()
diff --git a/src/MA/Functors/Product.hs b/src/MA/Functors/Product.hs
index 29ee9d9d9ad57fe75d329bb15df4a19bca6c6848..2c7430a53735d22765bd10cfd6bc4127104cee58 100644
--- a/src/MA/Functors/Product.hs
+++ b/src/MA/Functors/Product.hs
@@ -18,7 +18,7 @@ data Product a = Product a a
   deriving (Show, Functor, Foldable, Traversable)
 
 product :: FunctorParser Product
-product = InfixR $ do
+product = infixR $ do
   void $ L.symbol "×"
   return Product
 
diff --git a/src/MA/Parser.hs b/src/MA/Parser.hs
index 51b22c92f0a3f02acdeb92c534662d598cf34bd1..f8164cc8d051209a3266639b9c7f355601f1c954 100644
--- a/src/MA/Parser.hs
+++ b/src/MA/Parser.hs
@@ -6,7 +6,6 @@ module MA.Parser
   , readCoalgebraFromStdin
   ) where
 
-import           Control.Monad
 import           Data.Bifunctor
 import           Data.Proxy
 
@@ -29,7 +28,8 @@ coalgebraParser ::
      (Traversable f, ParseMorphism f)
   => [[FunctorParser f]]
   -> Parser (SymbolTable, Encoding (Label (Desorted f)) (H1 (Desorted f)))
-coalgebraParser = fmap annotateSorts . functorsParser >=> morphismsParser
+coalgebraParser functors =
+  functorsParser (concat functors) >>= return . annotateSorts >>= morphismsParser
 
 -- TODO: Needs better name
 type TheFunctor = Desorted SomeFunctor
diff --git a/tests/MA/FunctorExpression/ParserSpec.hs b/tests/MA/FunctorExpression/ParserSpec.hs
index e0c30427d761d1380f471a39f9bb5bb6fce40509..f651dadf97fd33ae5549eb287da61e7656422f5b 100644
--- a/tests/MA/FunctorExpression/ParserSpec.hs
+++ b/tests/MA/FunctorExpression/ParserSpec.hs
@@ -63,6 +63,7 @@ parseFunctorExpressionSpec = describe "parseFunctorExpression" $ do
   it "handles whitespace at the begining" $
     parsing `shouldSucceedOn` "  Pre X"
 
+
 -- A simple prefix parser
 
 data PrefixFunctor a = PrefixFunctor a
@@ -73,11 +74,11 @@ instance Eq1 PrefixFunctor where
 
 instance Show1 PrefixFunctor where
   liftShowsPrec show' _ prec (PrefixFunctor x) rest
-    | prec > 10 = "(PrefixFunctor" ++ show' 11 x (rest ++ ")")
-    | otherwise = "PrefixFunctor" ++ show' 11 x rest
+    | prec > 10 = "(PrefixFunctor " ++ show' 11 x (rest ++ ")")
+    | otherwise = "PrefixFunctor " ++ show' 11 x rest
 
 prefixParser :: FunctorParser PrefixFunctor
-prefixParser = Prefix (symbol "Pre" >> return PrefixFunctor)
+prefixParser = prefix (symbol "Pre" >> return PrefixFunctor)
 
 -- A simple postfix parser
 
@@ -93,7 +94,7 @@ instance Show1 PostfixFunctor where
     | otherwise = "PostfixFunctor " ++ show' 11 x rest
 
 postfixParser :: FunctorParser PostfixFunctor
-postfixParser = Postfix (symbol "Post" >> return PostfixFunctor)
+postfixParser = postfix (symbol "Post" >> return PostfixFunctor)
 
 -- List of functors