From d4a8fd5ff01ae6dbdf8779ee4b8cb795bf655bf1 Mon Sep 17 00:00:00 2001
From: TheMatten <matten@tuta.io>
Date: Fri, 1 Nov 2019 21:29:36 +0100
Subject: [PATCH] InlineRecCalls.hs: Fix ambiguous loopbreakers

---
 loopbreaker.cabal                 |  3 +--
 src/Loopbreaker/InlineRecCalls.hs | 20 ++++++++++++--------
 2 files changed, 13 insertions(+), 10 deletions(-)

diff --git a/loopbreaker.cabal b/loopbreaker.cabal
index eacef10..4c455ba 100644
--- a/loopbreaker.cabal
+++ b/loopbreaker.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: b56a57a63829e80e77783f285ed80370eb48a4b37fb1c92fa74e2870f29817f2
+-- hash: d119510f8f4cf364fb3685f93c9b5b4684667c45e0b103e35f11e635e2efe8cf
 
 name:           loopbreaker
 version:        0.1.1.1
@@ -52,7 +52,6 @@ test-suite loopbreaker-test
   main-is: Spec.hs
   other-modules:
       DisableFlagSpec
-      Experiments
       InlineRecCallsSpec
       PragmaDetectionSpec
       TestUtils
diff --git a/src/Loopbreaker/InlineRecCalls.hs b/src/Loopbreaker/InlineRecCalls.hs
index efb308f..6cd7985 100644
--- a/src/Loopbreaker/InlineRecCalls.hs
+++ b/src/Loopbreaker/InlineRecCalls.hs
@@ -85,13 +85,16 @@ inlineRecCall types inlined (Recursive, binds)
   dyn_flags <- getDynFlags
   liftIO $ debugTraceMsg dyn_flags 2 $ text "Loopbreaker:" <+> ppr fun_name
 
-  (loopb_name, loopb_decl) <- loopbreaker fun_name
+  let fun_type = M.lookup fun_name types
+
+  (loopb_name, loopb_decl) <- loopbreaker fun_name fun_type
+
+  let m_loopb_sig = loopbreakerSig loopb_name <$> fun_type
 
   fun_matches' <- everywhereM ( fmap (replaceVarNamesT fun_name loopb_name)
                               . inlineLocalRecCallsM
                               ) fun_matches
 
-  let m_loopb_sig = loopbreakerSig loopb_name <$> M.lookup fun_name types
 
   pure
     ( ( Recursive
@@ -109,9 +112,10 @@ inlineRecCall _ _ binds = pure (binds, [])
 
 ------------------------------------------------------------------------------
 -- | Creates loopbreaker and it's name from name of the original function.
-loopbreaker :: MonadUnique m => Name -> m (Name, LHsBind GhcRn)
-loopbreaker fun_name =
-  (id &&& loopbreakerDecl fun_name) <$> loopbreakerName fun_name
+loopbreaker :: MonadUnique m
+            => Name -> Maybe (LHsSigWcType GhcRn) -> m (Name, LHsBind GhcRn)
+loopbreaker fun_name fun_type =
+  (id &&& loopbreakerDecl fun_name fun_type) <$> loopbreakerName fun_name
 
 ------------------------------------------------------------------------------
 loopbreakerName :: MonadUnique m => Name -> m Name
@@ -119,11 +123,11 @@ loopbreakerName (occName -> occNameFS -> orig_fs) =
   flip mkSystemVarName (orig_fs <> "__Loopbreaker") <$> getUniqueM
 
 ------------------------------------------------------------------------------
-loopbreakerDecl :: Name -> Name -> LHsBind GhcRn
-loopbreakerDecl fun_name loopb_name =
+loopbreakerDecl :: Name -> Maybe (LHsSigWcType GhcRn) -> Name -> LHsBind GhcRn
+loopbreakerDecl fun_name fun_type loopb_name =
   noLoc $ mkTopFunBind Generated (noLoc loopb_name)
     [ mkSimpleMatch (mkPrefixFunRhs $ noLoc loopb_name) [] $
-        nlHsVar fun_name
+        maybe id (fmap noLoc . ExprWithTySig) fun_type $ nlHsVar fun_name
     ]
 
 ------------------------------------------------------------------------------