diff --git a/src/Algorithm.hs b/src/Algorithm.hs
index 202a3f1e66b058987dcc2d8ee1c63822e8c2dcae..76200a84c0b62df32da1019531041497c3524684 100644
--- a/src/Algorithm.hs
+++ b/src/Algorithm.hs
@@ -43,6 +43,7 @@ import qualified Data.RefinablePartition as Partition
 import           Data.RefinementInterface (RefinementInterface)
 import qualified Data.RefinementInterface as RI
 import           Data.Sort
+import           Data.Functors.SomeFunctor
 
 data AlgoState s h = AlgoState
   { toSub :: MVector s [EdgeRef]
@@ -204,15 +205,17 @@ processQueue queue states = whileM $ Queue.dequeue queue >>= \case
 data SomeAlgoState s where
   SomeAlgoState :: RefinementInterface h => AlgoState s h -> SomeAlgoState s
 
+type Morphism = Encoding (RI.Label SomeFunctor) (RI.H1 SomeFunctor)
+
 initializeAll :: Vector Morphism -> ST s (BlockQueue s, SortTable (SomeAlgoState s))
 initializeAll encodings = do
-  let sizes = fmap (\(Morphism _ x) -> size x) encodings
+  let sizes = fmap size encodings
 
   queue <- Queue.empty sizes
 
   sorts <- iforM (V.zip encodings (rotateVectorLeft sizes)) $
-    \sort (Morphism (_ :: h ()) encoding, nextSize) -> do
-      (blocks, state) <- initialize @h sort encoding nextSize
+    \sort (encoding, nextSize) -> do
+      (blocks, state) <- initialize @SomeFunctor sort encoding nextSize
       mapM_ (Queue.enqueue queue . (sort,)) blocks
       return (SomeAlgoState state)
 
diff --git a/src/Data/MorphismEncoding.hs b/src/Data/MorphismEncoding.hs
index 8639fce6b20cafb804ce8482227f11a6570e49d9..220fe1ff74c079ba5eb38cfa3bddd8b1afeae97e 100644
--- a/src/Data/MorphismEncoding.hs
+++ b/src/Data/MorphismEncoding.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE RecordWildCards #-}
 module Data.MorphismEncoding
   ( Encoding(..)
-  , SomeEncoding(..)
   , EdgeRef(..)
   , Edge(..)
   , new
@@ -32,12 +31,6 @@ data Encoding a h1 = Encoding
   }
   deriving (Show)
 
-data SomeEncoding where
-  SomeEncoding :: (Show a, Show h1) => Encoding a h1 -> SomeEncoding
-
-deriving instance Show SomeEncoding
-
-
 new :: Vector h1 -> Vector (Edge a) -> Encoding a h1
 new structure edges = Encoding {..}
 
diff --git a/src/Data/Sort.hs b/src/Data/Sort.hs
index a79d60c84dcf8a1504d6992b54f6f566bd8b128f..afad1198cf11e74df1b948839eedbe1ec689f8c3 100644
--- a/src/Data/Sort.hs
+++ b/src/Data/Sort.hs
@@ -3,16 +3,11 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
 module Data.Sort
-  ( Morphism(..)
-  , Sort
+  ( Sort
   , Sorted
   , SortTable
   ) where
 
-import           Data.Kind
-
-import           Data.RefinementInterface
-import           Data.MorphismEncoding
 import           Data.Vector (Vector)
 
 
@@ -22,9 +17,3 @@ type Sorted a = (Sort, a)
 
 -- | This type maps sorts to 'a'
 type SortTable a = Vector a
-
--- TODO This should really be somewhere else
-data Morphism :: Type where
-  Morphism :: RefinementInterface h => h () -> Encoding (Label h) (H1 h) -> Morphism
-
-deriving instance Show Morphism
diff --git a/src/Parser.hs b/src/Parser.hs
index bb8c28b98fdc765a17efcdefee03f3586c00249e..d207fd373443b94ff25ce65fdd19a5749045063c 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -16,9 +16,9 @@ import qualified Text.Megaparsec as Megaparsec
 
 import           Data.RefinementInterface
 import           Data.Functors (registeredFunctors)
-import           Data.Sort
-import qualified MA.FunctorExpression.Parser as New
-import qualified MA.FunctorExpression.Sorts as New
+import           Data.MorphismEncoding
+import           MA.FunctorExpression.Parser
+import           MA.FunctorExpression.Sorts
 import           Data.Functors.SomeFunctor
 
 
@@ -28,20 +28,18 @@ instance Yaml.FromJSON RFIList where
   parseJSON =
     Yaml.withText "functor expression" $ \expr -> do
       let res =
-            New.parseFunctorExpression
-              registeredFunctors
-              "functor expression"
-              expr
+            parseFunctorExpression registeredFunctors "functor expression" expr
       case res of
         Left err ->
           fail $
           "Invalid functor expression: " ++ Megaparsec.parseErrorPretty err
         Right functorExpression ->
-          let sorts = New.sortTable (New.annotateSorts functorExpression)
+          let sorts = sortTable (annotateSorts functorExpression)
            in return (RFIList sorts)
 
-newtype CoalgebraSpecification = CoalgebraSpecification { fromCoalg :: Vector Morphism }
-  deriving (Show)
+newtype CoalgebraSpecification = CoalgebraSpecification
+  { fromCoalg :: Vector (Encoding (Label SomeFunctor) (H1 SomeFunctor))
+  } deriving (Show)
 
 instance Yaml.FromJSON CoalgebraSpecification where
   parseJSON = Yaml.withObject "coalgebra" $ \obj -> do
@@ -50,10 +48,11 @@ instance Yaml.FromJSON CoalgebraSpecification where
 
     -- TODO Ensure functors and morphisms are of equal length
     encodings <- forM (V.zip functors morphisms) $
-      \(functor, yamlValue) ->
-        Morphism functor <$> parse functor yamlValue
+      \(functor, yamlValue) -> parse functor yamlValue
 
     return (CoalgebraSpecification encodings)
 
-decodeCoalgebra :: ByteString -> Either String (Vector Morphism)
+decodeCoalgebra ::
+     ByteString
+  -> Either String (Vector (Encoding (Label SomeFunctor) (H1 SomeFunctor)))
 decodeCoalgebra = fmap fromCoalg . Yaml.decodeEither