typediff: Normalize qualified names

typediff/src/TypeDiff.hs

@@ -5,6 +5,7 @@ module TypeDiff (
 , sigMap
 , typeEq
 , alphaNormalize
+, normalizeConstrainNames
 ) where
 
 import           Data.Char
@@ -68,7 +69,7 @@ sigMap = Map.fromList . map splitType . lines
 
 typeEq :: Type -> Type -> Bool
 typeEq t1 t2 = normalize t1 == normalize t2
-  where normalize = alphaNormalize . normalizeConstrains . sortConstrains
+  where normalize = alphaNormalize . normalizeConstrainNames . normalizeConstrains . sortConstrains
 
 sortConstrains :: Type -> Type
 sortConstrains x = case x of
@@ -99,3 +100,17 @@ alphaNormalize t = transformBi f t
 
     vars :: [Name]
     vars = map (Ident . ('t' :) . show) [0 :: Integer ..]
+
+normalizeConstrainNames :: Type -> Type
+normalizeConstrainNames t = transformBi f t
+  where
+    f :: QName -> QName
+    f name = case name of
+      Qual (ModuleName "GHC.Base") (Ident "Applicative") -> Qual (ModuleName "Control.Applicative") (Ident "Applicative")
+      Qual (ModuleName "GHC.Base") (Ident "Alternative") -> Qual (ModuleName "Control.Applicative") (Ident "Alternative")
+      Qual (ModuleName "GHC.Base") (Ident "MonadPlus") -> Qual (ModuleName "Control.Monad") (Ident "MonadPlus")
+      Qual (ModuleName "GHC.Base") (Ident "Maybe") -> Qual (ModuleName "Data.Maybe") (Ident "Maybe")
+      Qual (ModuleName "GHC.Base") (Ident "Monoid") -> Qual (ModuleName "Data.Monoid") (Ident "Monoid")
+      Qual (ModuleName "GHC.Types") (Ident "Bool") -> Qual (ModuleName "GHC.Bool") (Ident "Bool")
+      Qual (ModuleName "GHC.Types") (Ident "Ordering") -> Qual (ModuleName "GHC.Ordering") (Ident "Ordering")
+      _ -> name

typediff/test/TypeDiffSpec.hs

@@ -77,3 +77,35 @@ spec = do
       let ParseOk x = parseType "Int -> Float"
           ParseOk y = parseType "Int -> Float"
       alphaNormalize x `shouldBe` y
+
+  describe "normalizeConstrainNames" $ do
+    it "normalizes qualified name for Applicative" $ do
+      let ParseOk x = parseType "GHC.Base.Applicative f => f a"
+          ParseOk y = parseType "Control.Applicative.Applicative f => f a"
+      normalizeConstrainNames x `shouldBe` y
+
+    it "normalizes qualified name for Alternative" $ do
+      let ParseOk x = parseType "GHC.Base.Alternative f => f a"
+          ParseOk y = parseType "Control.Applicative.Alternative f => f a"
+      normalizeConstrainNames x `shouldBe` y
+
+    it "normalizes qualified name for MonadPlus" $ do
+      let ParseOk x = parseType "GHC.Base.MonadPlus m => m a"
+          ParseOk y = parseType "Control.Monad.MonadPlus m => m a"
+      normalizeConstrainNames x `shouldBe` y
+
+
+    it "normalizes qualified name for Maybe" $ do
+      let ParseOk x = parseType "GHC.Base.Maybe a"
+          ParseOk y = parseType "Data.Maybe.Maybe a"
+      normalizeConstrainNames x `shouldBe` y
+
+    it "normalizes qualified name for Monoid" $ do
+      let ParseOk x = parseType "GHC.Base.Monoid m => m"
+          ParseOk y = parseType "Data.Monoid.Monoid m => m"
+      normalizeConstrainNames x `shouldBe` y
+
+    it "normalizes qualified name for Bool" $ do
+      let ParseOk x = parseType "GHC.Types.Ordering"
+          ParseOk y = parseType "GHC.Ordering.Ordering"
+      normalizeConstrainNames x `shouldBe` y

typediff/typediff.cabal

@@ -1,5 +1,5 @@
 name:             typediff
-version:          0.0.0
+version:          0.1.0
 build-type:       Simple
 cabal-version:    >= 1.10