diff --git a/test/Compare/PreprocessSpec.hs b/test/Compare/PreprocessSpec.hs
index 37d1b08f8cce3f5636f81386674c53276e222c8f..91e9efa13113b43b246fe43a342608931ff6477e 100644
--- a/test/Compare/PreprocessSpec.hs
+++ b/test/Compare/PreprocessSpec.hs
@@ -1,13 +1,15 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Compare.PreprocessSpec (spec) where
 
-import Test.Hspec
+import           Test.Hspec
 
-import Lens.Micro
+import qualified Data.Graph.Inductive.Graph as G
+import           Lens.Micro
 
-import Compare.Preprocess
-import Compare.Types
-import Compare.Types.Lenses
+import           Compare.Preprocess
+import           Compare.Types
+import           Compare.Types.Lenses
+import           Compare.SSEGraph
 
 spec :: Spec
 spec = do
@@ -18,31 +20,32 @@ spec = do
 renameStartOSSpec :: Spec
 renameStartOSSpec = do
   it "does nothing for a graph without StartOS label" $
-    let g = mkGraph ["a", "b"] [("a", "b", "edge")] "a"
-    in preprocess g `shouldBe` g
+    let g = mkGraph ["a", "b"] [("a", "b", "edge/Foo")] "a"
+    in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` g
 
   it "renames the StartOS label" $
     let g1 = mkGraph ["a", "b"] [("a", "b", "ABB13/StartOS")] "a"
         g2 = mkGraph ["a", "b"] [("a", "b", "StartOS")] "a"
-    in preprocess g1 `shouldBe` g2
+    in preprocess (g1 & edges %~ SSEEdgeLabel) `shouldBe` g2
 
 renameIdleSpec :: Spec
 renameIdleSpec = do
   it "does nothing for a graph without StartOS label" $
-    let g = mkGraph ["a", "b"] [("a", "b", "edge")] "a"
-    in preprocess g `shouldBe` g
+    let g = mkGraph ["a", "b"] [("a", "b", "edge/Foo")] "a"
+    in preprocess (g & edges %~ SSEEdgeLabel) `shouldBe` g
 
   it "renames the idle loop edge label" $
     let g1 = mkGraph ["a", "b"] [("a", "b", "ABB25/Idle")] "a"
         g2 = mkGraph ["a", "b"] [("a", "b", "Idle")] "a"
-    in preprocess g1 `shouldBe` g2
+    in preprocess (g1 & edges %~ SSEEdgeLabel) `shouldBe` g2
 
 renameIdleKickoffSpec :: Spec
 renameIdleKickoffSpec =
   it "renames the kickoff label to the idle thread" $
     let g1 = mkGraph ["PreIdle", "Idle"] [ ("PreIdle", "Idle", "ABB42/kickoff")
-                                         , ("Idle", "Idle", "Idle") -- self loop
+                                         , ("Idle", "Idle", "ABB5/Idle") -- self loop
                                          ]
                      "PreIdle"
         g2 = g1 & edges . filtered (=="ABB42/kickoff") .~ "IdleKickoff"
-    in preprocess g1 `shouldBe` g2
+                & edges . filtered (=="ABB5/Idle") .~ "Idle"
+    in preprocess (g1 & _graph %~ G.emap SSEEdgeLabel) `shouldBe` g2