From 88f61724d49a2b3c8979dec48433604f591de7f3 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Mon, 18 Jan 2016 03:51:03 +0300
Subject: [PATCH 01/13] [Type-constraints] Proof-of-concept

---
 Language/Haskell/GhcMod/Gap.hs      |  2 ++
 Language/Haskell/GhcMod/Info.hs     | 26 +++++++++++++++++++++++---
 Language/Haskell/GhcMod/SrcUtils.hs |  8 ++++++++
 3 files changed, 33 insertions(+), 3 deletions(-)

diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs
index 48337e0..be770b6 100644
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@@ -316,11 +316,13 @@ setWarnTypedHoles = id
 ----------------------------------------------------------------
 
 class HasType a where
+    getId   :: GhcMonad m => TypecheckedModule -> a -> m ([Id])
     getType :: GhcMonad m => TypecheckedModule -> a -> m (Maybe (SrcSpan, Type))
 
 
 instance HasType (LHsBind Id) where
 #if __GLASGOW_HASKELL__ >= 708
+    getId _ b = return $ collectHsBindBinders (unLoc b)
     getType _ (L spn FunBind{fun_matches = m}) = return $ Just (spn, typ)
       where in_tys = mg_arg_tys m
             out_typ = mg_res_ty m
diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index 31a8eab..442c5de 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -11,6 +11,7 @@ import Exception (ghandle, SomeException(..))
 import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
 import Prelude
 import qualified GHC as G
+import qualified Var as G (varType)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 
 import Language.Haskell.GhcMod.Convert
@@ -23,6 +24,7 @@ import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
 import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
+import Control.Applicative
 
 ----------------------------------------------------------------
 
@@ -79,7 +81,25 @@ getSrcSpanType modSum lineNo colNo = do
   let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
       es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
       ps = listifySpans tcs (lineNo, colNo) :: [LPat Id]
-  bts <- mapM (getType tcm) bs
-  ets <- mapM (getType tcm) es
-  pts <- mapM (getType tcm) ps
+      as = concatMap abtoex $ listifyAbsBinds tcs
+      abtoex (G.L _spn G.AbsBinds{abs_exports = es'})
+        = liftA2 (,) G.abe_mono (G.varType . G.abe_poly) `map` es'
+      abtoex _ = []
+      getType' b = getType tcm b >>= tryGetConstrainedType b
+      tryGetConstrainedType _ Nothing = return Nothing
+      tryGetConstrainedType b (Just gt) =
+        do
+          ids <- getId tcm b
+          return $ ct ids <|> Just gt
+        where
+          ct [pid] = (,) (fst gt) <$> lookup pid as
+          -- TODO: A case of multiple ids should probably
+          -- collect all constraints and then apply
+          -- them to calculated type. No idea how
+          -- to do that at the moment.
+          ct _     = Nothing
+
+  ets <- mapM getType' es
+  bts <- mapM getType' bs
+  pts <- mapM getType' ps
   return $ catMaybes $ concat [ets, bts, pts]
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 0938f81..5571c95 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -24,12 +24,14 @@ import Prelude
 ----------------------------------------------------------------
 
 instance HasType (LHsExpr Id) where
+    getId _ _e = return []
     getType tcm e = do
         hs_env <- G.getSession
         mbe <- liftIO $ Gap.deSugar tcm e hs_env
         return $ (G.getLoc e, ) <$> CoreUtils.exprType <$> mbe
 
 instance HasType (LPat Id) where
+    getId _ = return . G.collectPatBinders
     getType _ (G.L spn pat) = return $ Just (spn, hsPatType pat)
 
 ----------------------------------------------------------------
@@ -39,6 +41,12 @@ listifySpans tcs lc = listifyStaged TypeChecker p tcs
   where
     p (L spn _) = G.isGoodSrcSpan spn && spn `G.spans` lc
 
+listifyAbsBinds :: TypecheckedSource -> [Located (G.HsBind Id)]
+listifyAbsBinds = listifyStaged TypeChecker p
+  where
+    p (L _ G.AbsBinds{}) = True
+    p _                  = False
+
 listifyParsedSpans :: Typeable a => ParsedSource -> (Int, Int) -> [Located a]
 listifyParsedSpans pcs lc = listifyStaged Parser p pcs
   where

From 966c694dbf9133064c5fc3996eefc51afc3585f7 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Mon, 18 Jan 2016 07:03:05 +0300
Subject: [PATCH 02/13] [Type-constraints] Initial attempt at compounds

I try to compute constraints for "compound" types.
While constraint-building itself is simple, types
do not match due to different representation
between 'internal' and 'exported' signatures.
---
 Language/Haskell/GhcMod/Info.hs | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index 442c5de..befc8e5 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -5,10 +5,10 @@ module Language.Haskell.GhcMod.Info (
 
 import Data.Function (on)
 import Data.List (sortBy)
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, mapMaybe)
 import System.FilePath
 import Exception (ghandle, SomeException(..))
-import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
+import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan)
 import Prelude
 import qualified GHC as G
 import qualified Var as G (varType)
@@ -25,6 +25,8 @@ import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
 import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
 import Control.Applicative
+import Type
+import Control.Arrow
 
 ----------------------------------------------------------------
 
@@ -93,11 +95,26 @@ getSrcSpanType modSum lineNo colNo = do
           return $ ct ids <|> Just gt
         where
           ct [pid] = (,) (fst gt) <$> lookup pid as
+          ct []    = Nothing
           -- TODO: A case of multiple ids should probably
           -- collect all constraints and then apply
           -- them to calculated type. No idea how
           -- to do that at the moment.
-          ct _     = Nothing
+          -- NB: The following does not work, since
+          -- "inner" types have different IDs from
+          -- exported types. So we need some sort of
+          -- type substitution.
+          ct pids  =
+            let
+              ctys  = mapMaybe (`lookup` as) pids
+              preds = concatMap (fst . getPreds) ctys
+              --typs  = map (snd . getPreds) ctys
+              ty    = mkFunTys preds $ snd gt
+            in Just (fst gt, ty)
+          getPreds x | isForAllTy x = getPreds $ dropForAlls x
+                     | Just (c, t) <- splitFunTy_maybe x
+                     , isPredTy c = first (c:) $ getPreds t
+                     | otherwise = ([], x)
 
   ets <- mapM getType' es
   bts <- mapM getType' bs

From 549d3e1006bd062fda766dd4ccbbaedb1d984da6 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Mon, 18 Jan 2016 09:02:28 +0300
Subject: [PATCH 03/13] [Type-constraints] Compounds type substitution

---
 Language/Haskell/GhcMod/Info.hs | 25 ++++++++++++-------------
 1 file changed, 12 insertions(+), 13 deletions(-)

diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index befc8e5..d247488 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -96,21 +96,20 @@ getSrcSpanType modSum lineNo colNo = do
         where
           ct [pid] = (,) (fst gt) <$> lookup pid as
           ct []    = Nothing
-          -- TODO: A case of multiple ids should probably
-          -- collect all constraints and then apply
-          -- them to calculated type. No idea how
-          -- to do that at the moment.
-          -- NB: The following does not work, since
-          -- "inner" types have different IDs from
-          -- exported types. So we need some sort of
-          -- type substitution.
           ct pids  =
             let
-              ctys  = mapMaybe (`lookup` as) pids
-              preds = concatMap (fst . getPreds) ctys
-              --typs  = map (snd . getPreds) ctys
-              ty    = mkFunTys preds $ snd gt
-            in Just (fst gt, ty)
+              ctys  = mapMaybe build pids
+              build x | Just cti <- x `lookup` as
+                      = let
+                          (preds', ctt) = getPreds cti
+                          vt = G.varType x
+                        in Just (preds', flip (,) vt <$> getTyVar_maybe ctt)
+                      | otherwise = Nothing
+              sty   = snd gt
+              preds = concatMap fst ctys
+              subs  = mkTopTvSubst $ mapMaybe snd ctys
+              ty    = substTy subs $ mkFunTys preds sty
+            in Just (fst gt, tidyTopType ty)
           getPreds x | isForAllTy x = getPreds $ dropForAlls x
                      | Just (c, t) <- splitFunTy_maybe x
                      , isPredTy c = first (c:) $ getPreds t

From 960a49c1ed958c9e5658cc10d942c0eb32f9aaf7 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Tue, 19 Jan 2016 22:50:14 +0300
Subject: [PATCH 04/13] [Type-constraints] Marginally better version

* Instead of listify, it walks the tree instead, so that constraints are only visible in relevant context.
* Uses Map instead of [(,)]
* Performs type substitutions in case of one child identifier found (relevant for constructor bindings)
---
 Language/Haskell/GhcMod/Info.hs     | 55 ++++-------------------------
 Language/Haskell/GhcMod/SrcUtils.hs | 54 ++++++++++++++++++++++++++--
 2 files changed, 57 insertions(+), 52 deletions(-)

diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index d247488..6b08caf 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -5,13 +5,11 @@ module Language.Haskell.GhcMod.Info (
 
 import Data.Function (on)
 import Data.List (sortBy)
-import Data.Maybe (catMaybes, mapMaybe)
 import System.FilePath
 import Exception (ghandle, SomeException(..))
-import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan)
+import GHC (GhcMonad, SrcSpan)
 import Prelude
 import qualified GHC as G
-import qualified Var as G (varType)
 import qualified Language.Haskell.GhcMod.Gap as Gap
 
 import Language.Haskell.GhcMod.Convert
@@ -24,9 +22,6 @@ import Language.Haskell.GhcMod.SrcUtils
 import Language.Haskell.GhcMod.Types
 import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
 import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
-import Control.Applicative
-import Type
-import Control.Arrow
 
 ----------------------------------------------------------------
 
@@ -76,46 +71,8 @@ types file lineNo colNo =
      gmLog GmException "types" $ showDoc ex
      return []
 
-getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
-getSrcSpanType modSum lineNo colNo = do
-  p <- G.parseModule modSum
-  tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
-  let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
-      es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
-      ps = listifySpans tcs (lineNo, colNo) :: [LPat Id]
-      as = concatMap abtoex $ listifyAbsBinds tcs
-      abtoex (G.L _spn G.AbsBinds{abs_exports = es'})
-        = liftA2 (,) G.abe_mono (G.varType . G.abe_poly) `map` es'
-      abtoex _ = []
-      getType' b = getType tcm b >>= tryGetConstrainedType b
-      tryGetConstrainedType _ Nothing = return Nothing
-      tryGetConstrainedType b (Just gt) =
-        do
-          ids <- getId tcm b
-          return $ ct ids <|> Just gt
-        where
-          ct [pid] = (,) (fst gt) <$> lookup pid as
-          ct []    = Nothing
-          ct pids  =
-            let
-              ctys  = mapMaybe build pids
-              build x | Just cti <- x `lookup` as
-                      = let
-                          (preds', ctt) = getPreds cti
-                          vt = G.varType x
-                        in Just (preds', flip (,) vt <$> getTyVar_maybe ctt)
-                      | otherwise = Nothing
-              sty   = snd gt
-              preds = concatMap fst ctys
-              subs  = mkTopTvSubst $ mapMaybe snd ctys
-              ty    = substTy subs $ mkFunTys preds sty
-            in Just (fst gt, tidyTopType ty)
-          getPreds x | isForAllTy x = getPreds $ dropForAlls x
-                     | Just (c, t) <- splitFunTy_maybe x
-                     , isPredTy c = first (c:) $ getPreds t
-                     | otherwise = ([], x)
-
-  ets <- mapM getType' es
-  bts <- mapM getType' bs
-  pts <- mapM getType' ps
-  return $ catMaybes $ concat [ets, bts, pts]
+getSrcSpanType :: (GhcMonad m) => G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
+getSrcSpanType modSum lineNo colNo =
+  G.parseModule modSum
+  >>= G.typecheckModule
+  >>= flip collectSpansTypes (lineNo, colNo)
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 5571c95..2197a58 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TupleSections, FlexibleInstances, Rank2Types #-}
+{-# LANGUAGE TupleSections, FlexibleInstances, Rank2Types, ImpredicativeTypes #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Language.Haskell.GhcMod.SrcUtils where
@@ -6,11 +6,14 @@ module Language.Haskell.GhcMod.SrcUtils where
 import Control.Applicative
 import CoreUtils (exprType)
 import Data.Generics
-import Data.Maybe (fromMaybe)
+import Data.Maybe
 import Data.Ord as O
 import GHC (LHsExpr, LPat, Id, DynFlags, SrcSpan, Type, Located, ParsedSource, RenamedSource, TypecheckedSource, GenLocated(L))
+import Var (Var)
 import qualified GHC as G
-import GHC.SYB.Utils (Stage(..), everythingStaged)
+import qualified Var as G
+import qualified Type as G
+import GHC.SYB.Utils
 import GhcMonad
 import qualified Language.Haskell.Exts.Annotated as HE
 import Language.Haskell.GhcMod.Doc
@@ -20,6 +23,9 @@ import OccName (OccName)
 import Outputable (PprStyle)
 import TcHsSyn (hsPatType)
 import Prelude
+import Control.Monad
+import Control.Arrow
+import qualified Data.Map as M
 
 ----------------------------------------------------------------
 
@@ -36,6 +42,48 @@ instance HasType (LPat Id) where
 
 ----------------------------------------------------------------
 
+type CstGenQS = M.Map Var Type
+type CstGenQT = forall m. GhcMonad m => CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
+
+collectSpansTypes :: (GhcMonad m) => G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
+collectSpansTypes tcs lc =
+  everythingWithContext M.empty (liftM2 (++))
+    ((return [],) `mkQ` hsBind `extQ` hsExpr `extQ` hsPat)
+    (G.tm_typechecked_source tcs)
+  where
+    insExp x = M.insert (G.abe_mono x) (G.varType $ G.abe_poly x)
+    hsBind :: G.LHsBind Id -> CstGenQT
+    hsBind (L _ G.AbsBinds{abs_exports = es'}) s
+      = (return [], foldr insExp s es')
+    hsBind x@(L _ b) s = constrainedType' (G.collectHsBindBinders b) s x
+    hsExpr :: G.LHsExpr Id -> CstGenQT
+    hsExpr x s = (maybeToList <$> getType' x, s)
+    hsPat :: G.LPat Id -> CstGenQT
+    hsPat x@(L _ _) s = constrainedType' (G.collectPatBinders x) s x
+    getType' x@(L spn _)
+      | G.isGoodSrcSpan spn && spn `G.spans` lc
+      = getType tcs x
+      | otherwise = return Nothing
+    constrainedType' pids s x =
+        (maybe [] (uncurry $ constrainedType pids s) <$> getType' x, s)
+    constrainedType pids s spn genTyp =
+      let
+        ctys  = mapMaybe build pids
+        build x | Just cti <- x `M.lookup` s
+                = let
+                    (preds', ctt) = getPreds cti
+                    vt = G.varType x
+                  in (preds',) . (, vt) <$> G.getTyVar_maybe ctt
+                | otherwise = Nothing
+        preds = concatMap fst ctys
+        subs  = G.mkTopTvSubst $ map snd ctys
+        ty    = G.substTy subs $ G.mkFunTys preds genTyp
+      in [(spn, G.tidyTopType ty)]
+    getPreds x | G.isForAllTy x = getPreds $ G.dropForAlls x
+               | Just (c, t) <- G.splitFunTy_maybe x
+               , G.isPredTy c = first (c:) $ getPreds t
+               | otherwise = ([], x)
+
 listifySpans :: Typeable a => TypecheckedSource -> (Int, Int) -> [Located a]
 listifySpans tcs lc = listifyStaged TypeChecker p tcs
   where

From 39659b2917583b6a6499b3bd468b9777b1c74ac6 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Tue, 19 Jan 2016 22:52:06 +0300
Subject: [PATCH 05/13] [Type-constraints] Removed unnecessary definitions

---
 Language/Haskell/GhcMod/Gap.hs      | 2 --
 Language/Haskell/GhcMod/SrcUtils.hs | 8 --------
 2 files changed, 10 deletions(-)

diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs
index be770b6..48337e0 100644
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@@ -316,13 +316,11 @@ setWarnTypedHoles = id
 ----------------------------------------------------------------
 
 class HasType a where
-    getId   :: GhcMonad m => TypecheckedModule -> a -> m ([Id])
     getType :: GhcMonad m => TypecheckedModule -> a -> m (Maybe (SrcSpan, Type))
 
 
 instance HasType (LHsBind Id) where
 #if __GLASGOW_HASKELL__ >= 708
-    getId _ b = return $ collectHsBindBinders (unLoc b)
     getType _ (L spn FunBind{fun_matches = m}) = return $ Just (spn, typ)
       where in_tys = mg_arg_tys m
             out_typ = mg_res_ty m
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 2197a58..bc013db 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -30,14 +30,12 @@ import qualified Data.Map as M
 ----------------------------------------------------------------
 
 instance HasType (LHsExpr Id) where
-    getId _ _e = return []
     getType tcm e = do
         hs_env <- G.getSession
         mbe <- liftIO $ Gap.deSugar tcm e hs_env
         return $ (G.getLoc e, ) <$> CoreUtils.exprType <$> mbe
 
 instance HasType (LPat Id) where
-    getId _ = return . G.collectPatBinders
     getType _ (G.L spn pat) = return $ Just (spn, hsPatType pat)
 
 ----------------------------------------------------------------
@@ -89,12 +87,6 @@ listifySpans tcs lc = listifyStaged TypeChecker p tcs
   where
     p (L spn _) = G.isGoodSrcSpan spn && spn `G.spans` lc
 
-listifyAbsBinds :: TypecheckedSource -> [Located (G.HsBind Id)]
-listifyAbsBinds = listifyStaged TypeChecker p
-  where
-    p (L _ G.AbsBinds{}) = True
-    p _                  = False
-
 listifyParsedSpans :: Typeable a => ParsedSource -> (Int, Int) -> [Located a]
 listifyParsedSpans pcs lc = listifyStaged Parser p pcs
   where

From fde7bafe567e0bf88ff4220736a2b0a85d0fac47 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 00:01:41 +0300
Subject: [PATCH 06/13] [Type-constraints] Fix type variable substitution

---
 Language/Haskell/GhcMod/SrcUtils.hs | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index bc013db..209e71a 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -70,11 +70,12 @@ collectSpansTypes tcs lc =
         build x | Just cti <- x `M.lookup` s
                 = let
                     (preds', ctt) = getPreds cti
-                    vt = G.varType x
-                  in (preds',) . (, vt) <$> G.getTyVar_maybe ctt
+                    vts = listifyStaged TypeChecker G.isTyVar $ G.varType x
+                    tvm = listifyStaged TypeChecker G.isTyVarTy ctt
+                  in Just (preds', zip vts tvm)
                 | otherwise = Nothing
         preds = concatMap fst ctys
-        subs  = G.mkTopTvSubst $ map snd ctys
+        subs  = G.mkTopTvSubst $ concatMap snd ctys
         ty    = G.substTy subs $ G.mkFunTys preds genTyp
       in [(spn, G.tidyTopType ty)]
     getPreds x | G.isForAllTy x = getPreds $ G.dropForAlls x

From 4e4eff7bdba443dcb5d21c3c477d26f447e54642 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 00:10:18 +0300
Subject: [PATCH 07/13] [Type-constraints] Remove tidyTopType

It didn't do much anyway
---
 Language/Haskell/GhcMod/SrcUtils.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 209e71a..ba05a06 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -77,7 +77,7 @@ collectSpansTypes tcs lc =
         preds = concatMap fst ctys
         subs  = G.mkTopTvSubst $ concatMap snd ctys
         ty    = G.substTy subs $ G.mkFunTys preds genTyp
-      in [(spn, G.tidyTopType ty)]
+      in [(spn, ty)]
     getPreds x | G.isForAllTy x = getPreds $ G.dropForAlls x
                | Just (c, t) <- G.splitFunTy_maybe x
                , G.isPredTy c = first (c:) $ getPreds t

From aedc6b6b31e630cbaeeb8a97cec50ca4079a81a6 Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 01:00:13 +0300
Subject: [PATCH 08/13] [Type-constraints] everythingStagedWithContext

This is required for GHC<7.10 due to a panic
---
 Language/Haskell/GhcMod/Gap.hs      | 20 ++++++++++++++++++++
 Language/Haskell/GhcMod/SrcUtils.hs |  3 ++-
 2 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/Language/Haskell/GhcMod/Gap.hs b/Language/Haskell/GhcMod/Gap.hs
index 48337e0..d60b578 100644
--- a/Language/Haskell/GhcMod/Gap.hs
+++ b/Language/Haskell/GhcMod/Gap.hs
@@ -44,6 +44,7 @@ module Language.Haskell.GhcMod.Gap (
   , Language.Haskell.GhcMod.Gap.isSynTyCon
   , parseModuleHeader
   , mkErrStyle'
+  , everythingStagedWithContext
   ) where
 
 import Control.Applicative hiding (empty)
@@ -111,6 +112,8 @@ import Lexer as L
 import Parser
 import SrcLoc
 import Packages
+import Data.Generics (GenericQ, extQ, gmapQ)
+import GHC.SYB.Utils (Stage(..))
 
 import Language.Haskell.GhcMod.Types (Expression(..))
 import Prelude
@@ -575,3 +578,20 @@ instance NFData ByteString where
   rnf Empty       = ()
   rnf (Chunk _ b) = rnf b
 #endif
+
+-- | Like 'everything', but avoid known potholes, based on the 'Stage' that
+--   generated the Ast.
+everythingStagedWithContext :: Stage -> s -> (r -> r -> r) -> r -> GenericQ (s -> (r, s)) -> GenericQ r
+everythingStagedWithContext stage s0 f z q x
+  | (const False
+#if __GLASGOW_HASKELL__ <= 708
+      `extQ` postTcType
+#endif
+      `extQ` fixity `extQ` nameSet) x = z
+  | otherwise = foldl f r (gmapQ (everythingStagedWithContext stage s' f z q) x)
+  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
+#if __GLASGOW_HASKELL__ <= 708
+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool
+#endif
+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool
+        (r, s') = q x s0
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index ba05a06..8bb988e 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -45,7 +45,8 @@ type CstGenQT = forall m. GhcMonad m => CstGenQS -> (m [(SrcSpan, Type)], CstGen
 
 collectSpansTypes :: (GhcMonad m) => G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
 collectSpansTypes tcs lc =
-  everythingWithContext M.empty (liftM2 (++))
+  everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
+    (return [])
     ((return [],) `mkQ` hsBind `extQ` hsExpr `extQ` hsPat)
     (G.tm_typechecked_source tcs)
   where

From 0c5da02d521f66ce0d54a44bcaf460aca09b3edf Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 01:29:33 +0300
Subject: [PATCH 09/13] [Type-constraints] Add an option to toggle this

---
 Language/Haskell/GhcMod/Info.hs     | 13 +++++++------
 Language/Haskell/GhcMod/SrcUtils.hs | 13 ++++++++-----
 src/GHCMod.hs                       |  2 +-
 src/GHCMod/Options/Commands.hs      | 30 ++++++++++++++++-------------
 4 files changed, 33 insertions(+), 25 deletions(-)

diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs
index 6b08caf..dc18f7c 100644
--- a/Language/Haskell/GhcMod/Info.hs
+++ b/Language/Haskell/GhcMod/Info.hs
@@ -52,17 +52,18 @@ info file expr =
 
 -- | Obtaining type of a target expression. (GHCi's type:)
 types :: IOish m
-      => FilePath     -- ^ A target file.
+      => Bool         -- ^ Include constraints into type signature
+      -> FilePath     -- ^ A target file.
       -> Int          -- ^ Line number.
       -> Int          -- ^ Column number.
       -> GhcModT m String
-types file lineNo colNo =
+types withConstraints file lineNo colNo =
   ghandle handler $
     runGmlT' [Left file] deferErrors $
       withInteractiveContext $ do
         crdl         <- cradle
         modSum       <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
-        srcSpanTypes <- getSrcSpanType modSum lineNo colNo
+        srcSpanTypes <- getSrcSpanType withConstraints modSum lineNo colNo
         dflag        <- G.getSessionDynFlags
         st           <- getStyle
         convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
@@ -71,8 +72,8 @@ types file lineNo colNo =
      gmLog GmException "types" $ showDoc ex
      return []
 
-getSrcSpanType :: (GhcMonad m) => G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
-getSrcSpanType modSum lineNo colNo =
+getSrcSpanType :: (GhcMonad m) => Bool -> G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
+getSrcSpanType withConstraints modSum lineNo colNo =
   G.parseModule modSum
   >>= G.typecheckModule
-  >>= flip collectSpansTypes (lineNo, colNo)
+  >>= flip (collectSpansTypes withConstraints) (lineNo, colNo)
diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 8bb988e..803d599 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -43,8 +43,8 @@ instance HasType (LPat Id) where
 type CstGenQS = M.Map Var Type
 type CstGenQT = forall m. GhcMonad m => CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
 
-collectSpansTypes :: (GhcMonad m) => G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
-collectSpansTypes tcs lc =
+collectSpansTypes :: (GhcMonad m) => Bool -> G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
+collectSpansTypes withConstraints tcs lc =
   everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
     (return [])
     ((return [],) `mkQ` hsBind `extQ` hsExpr `extQ` hsPat)
@@ -53,7 +53,8 @@ collectSpansTypes tcs lc =
     insExp x = M.insert (G.abe_mono x) (G.varType $ G.abe_poly x)
     hsBind :: G.LHsBind Id -> CstGenQT
     hsBind (L _ G.AbsBinds{abs_exports = es'}) s
-      = (return [], foldr insExp s es')
+      | withConstraints = (return [], foldr insExp s es')
+      | otherwise       = (return [], s)
     hsBind x@(L _ b) s = constrainedType' (G.collectHsBindBinders b) s x
     hsExpr :: G.LHsExpr Id -> CstGenQT
     hsExpr x s = (maybeToList <$> getType' x, s)
@@ -63,8 +64,10 @@ collectSpansTypes tcs lc =
       | G.isGoodSrcSpan spn && spn `G.spans` lc
       = getType tcs x
       | otherwise = return Nothing
-    constrainedType' pids s x =
-        (maybe [] (uncurry $ constrainedType pids s) <$> getType' x, s)
+    constrainedType' pids s x
+        | withConstraints
+        = (maybe [] (uncurry $ constrainedType pids s) <$> getType' x, s)
+        | otherwise = (maybeToList <$> getType' x, s)
     constrainedType pids s spn genTyp =
       let
         ctys  = mapMaybe build pids
diff --git a/src/GHCMod.hs b/src/GHCMod.hs
index fdade72..8e517a8 100644
--- a/src/GHCMod.hs
+++ b/src/GHCMod.hs
@@ -150,7 +150,7 @@ ghcCommands (CmdBrowse opts ms) = concat <$> browse opts `mapM` ms
 ghcCommands (CmdCheck files) = checkSyntax files
 ghcCommands (CmdExpand files) = expandTemplate files
 ghcCommands (CmdInfo file symb) = info file $ Expression symb
-ghcCommands (CmdType file (line, col)) = types file line col
+ghcCommands (CmdType wCon file (line, col)) = types wCon file line col
 ghcCommands (CmdSplit file (line, col)) = splits file line col
 ghcCommands (CmdSig file (line, col)) = sig file line col
 ghcCommands (CmdAuto file (line, col)) = auto file line col
diff --git a/src/GHCMod/Options/Commands.hs b/src/GHCMod/Options/Commands.hs
index 2e1f60a..275d4ae 100644
--- a/src/GHCMod/Options/Commands.hs
+++ b/src/GHCMod/Options/Commands.hs
@@ -51,7 +51,7 @@ data GhcModCommands =
   | CmdCheck [FilePath]
   | CmdExpand [FilePath]
   | CmdInfo FilePath Symbol
-  | CmdType FilePath Point
+  | CmdType Bool FilePath Point
   | CmdSplit FilePath Point
   | CmdSig FilePath Point
   | CmdAuto FilePath Point
@@ -215,12 +215,12 @@ interactiveCommandsSpec =
 strArg :: String -> Parser String
 strArg = argument str . metavar
 
-filesArgsSpec :: ([String] -> b) -> Parser b
-filesArgsSpec x = x <$> some (strArg "FILES..")
+filesArgsSpec :: Parser ([String] -> b) -> Parser b
+filesArgsSpec x = x <*> some (strArg "FILES..")
 
-locArgSpec :: (String -> (Int, Int) -> b) -> Parser b
+locArgSpec :: Parser (String -> (Int, Int) -> b) -> Parser b
 locArgSpec x = x
-  <$> strArg "FILE"
+  <*> strArg "FILE"
   <*> ( (,)
         <$> argument int (metavar "LINE")
         <*> argument int (metavar "COL")
@@ -261,17 +261,21 @@ browseArgSpec = CmdBrowse
             <=> help "Qualify symbols"
       )
   <*> some (strArg "MODULE")
-debugComponentArgSpec = filesArgsSpec CmdDebugComponent
-checkArgSpec = filesArgsSpec CmdCheck
-expandArgSpec = filesArgsSpec CmdExpand
+debugComponentArgSpec = filesArgsSpec (pure CmdDebugComponent)
+checkArgSpec = filesArgsSpec (pure CmdCheck)
+expandArgSpec = filesArgsSpec (pure CmdExpand)
 infoArgSpec = CmdInfo
     <$> strArg "FILE"
     <*> strArg "SYMBOL"
-typeArgSpec = locArgSpec CmdType
-autoArgSpec = locArgSpec CmdAuto
-splitArgSpec = locArgSpec CmdSplit
-sigArgSpec = locArgSpec CmdSig
-refineArgSpec = locArgSpec CmdRefine <*> strArg "SYMBOL"
+typeArgSpec = locArgSpec $ CmdType <$>
+        switch
+          $$  long "constraints"
+          <=> short 'c'
+          <=> help "Include constraints into type signature"
+autoArgSpec = locArgSpec (pure CmdAuto)
+splitArgSpec = locArgSpec (pure CmdSplit)
+sigArgSpec = locArgSpec (pure CmdSig)
+refineArgSpec = locArgSpec (pure CmdRefine) <*> strArg "SYMBOL"
 mapArgSpec = CmdMapFile <$> strArg "FILE"
 unmapArgSpec = CmdUnmapFile <$> strArg "FILE"
 legacyInteractiveArgSpec = const CmdLegacyInteractive <$>

From c117ed3b52d8ebe4722a3f179483f24ba2536e7d Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 01:34:58 +0300
Subject: [PATCH 10/13] [Type-constraints] Some tests

---
 test/FileMappingSpec.hs | 14 ++++++++++----
 test/InfoSpec.hs        | 11 ++++++++---
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/test/FileMappingSpec.hs b/test/FileMappingSpec.hs
index 943465a..876e10a 100644
--- a/test/FileMappingSpec.hs
+++ b/test/FileMappingSpec.hs
@@ -134,13 +134,19 @@ spec = do
             let tdir = "test/data/file-mapping"
             res <- runD' tdir $ do
               loadMappedFile "File.hs" "File_Redir_Lint.hs"
-              types "File.hs" 4 12
+              types False "File.hs" 4 12
             res `shouldBe` "4 12 4 15 \"a -> a -> a\"\n4 12 4 17 \"a -> a\"\n4 12 4 19 \"a\"\n4 1 4 19 \"a -> a -> a\"\n"
+        it "shows types of the expression with constraints for redirected files" $ do
+            let tdir = "test/data/file-mapping"
+            res <- runD' tdir $ do
+              loadMappedFile "File.hs" "File_Redir_Lint.hs"
+              types True "File.hs" 4 12
+            res `shouldBe` "4 12 4 15 \"a -> a -> a\"\n4 12 4 17 \"a -> a\"\n4 12 4 19 \"a\"\n4 1 4 19 \"Num a => a -> a -> a\"\n"
         it "shows types of the expression for in-memory files" $ do
             let tdir = "test/data/file-mapping"
             res <- runD' tdir $ do
               loadMappedFileSource "File.hs" "main = putStrLn \"Hello!\""
-              types "File.hs" 1 14
+              types False "File.hs" 1 14
             res `shouldBe` "1 8 1 16 \"String -> IO ()\"\n1 8 1 25 \"IO ()\"\n1 1 1 25 \"IO ()\"\n"
         it "shows info for the expression for redirected files" $ do
             let tdir = "test/data/file-mapping"
@@ -234,7 +240,7 @@ spec = do
                        ,("Bar.hs", tmpdir </> "Bar_Redir.hs")]
               res <- run defaultOptions $ do
                 mapM_ (uncurry loadMappedFile) fm
-                types "Bar.hs" 5 1
+                types False "Bar.hs" 5 1
               res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
         it "works with a memory module using TemplateHaskell" $ do
           srcFoo <- readFile "test/data/template-haskell/Foo.hs"
@@ -244,5 +250,5 @@ spec = do
                      ,("Bar.hs", srcBar)]
             res <- run defaultOptions $ do
               mapM_ (uncurry loadMappedFileSource) fm
-              types "Bar.hs" 5 1
+              types False "Bar.hs" 5 1
             res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
diff --git a/test/InfoSpec.hs b/test/InfoSpec.hs
index 3bdd5ae..d084b9a 100644
--- a/test/InfoSpec.hs
+++ b/test/InfoSpec.hs
@@ -19,17 +19,22 @@ spec = do
     describe "types" $ do
         it "shows types of the expression and its outers" $ do
             let tdir = "test/data/ghc-mod-check"
-            res <- runD' tdir $ types "lib/Data/Foo.hs" 9 5
+            res <- runD' tdir $ types False "lib/Data/Foo.hs" 9 5
             res `shouldBe` "9 5 11 40 \"Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
 
+        it "shows types of the expression with constraints and its outers" $ do
+            let tdir = "test/data/ghc-mod-check"
+            res <- runD' tdir $ types True "lib/Data/Foo.hs" 9 5
+            res `shouldBe` "9 5 11 40 \"Num a => Int -> a -> a -> a\"\n7 1 11 40 \"Int -> Integer\"\n"
+
         it "works with a module using TemplateHaskell" $ do
             let tdir = "test/data/template-haskell"
-            res <- runD' tdir $ types "Bar.hs" 5 1
+            res <- runD' tdir $ types False "Bar.hs" 5 1
             res `shouldBe` unlines ["5 1 5 20 \"[Char]\""]
 
         it "works with a module that imports another module using TemplateHaskell" $ do
             let tdir = "test/data/template-haskell"
-            res <- runD' tdir $ types "ImportsTH.hs" 3 8
+            res <- runD' tdir $ types False "ImportsTH.hs" 3 8
             res `shouldBe` unlines ["3 8 3 16 \"String -> IO ()\"", "3 8 3 20 \"IO ()\"", "3 1 3 20 \"IO ()\""]
 
     describe "info" $ do

From 8449d36ecaac8080ba963224d5bc6125d1acf76e Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 02:23:51 +0300
Subject: [PATCH 11/13] [Type-constraints] Generalize some code, cleanup

---
 Language/Haskell/GhcMod/SrcUtils.hs | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 803d599..833624b 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -41,25 +41,27 @@ instance HasType (LPat Id) where
 ----------------------------------------------------------------
 
 type CstGenQS = M.Map Var Type
-type CstGenQT = forall m. GhcMonad m => CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
+type CstGenQT a = forall m. GhcMonad m => a Id -> CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
 
 collectSpansTypes :: (GhcMonad m) => Bool -> G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
 collectSpansTypes withConstraints tcs lc =
   everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
     (return [])
-    ((return [],) `mkQ` hsBind `extQ` hsExpr `extQ` hsPat)
+    ((return [],)
+      `mkQ`  (hsBind    :: CstGenQT G.LHsBind)
+      `extQ` (genericCT :: CstGenQT G.LHsExpr)
+      `extQ` (genericCT :: CstGenQT G.LPat)
+      )
     (G.tm_typechecked_source tcs)
   where
     insExp x = M.insert (G.abe_mono x) (G.varType $ G.abe_poly x)
-    hsBind :: G.LHsBind Id -> CstGenQT
     hsBind (L _ G.AbsBinds{abs_exports = es'}) s
       | withConstraints = (return [], foldr insExp s es')
       | otherwise       = (return [], s)
-    hsBind x@(L _ b) s = constrainedType' (G.collectHsBindBinders b) s x
-    hsExpr :: G.LHsExpr Id -> CstGenQT
-    hsExpr x s = (maybeToList <$> getType' x, s)
-    hsPat :: G.LPat Id -> CstGenQT
-    hsPat x@(L _ _) s = constrainedType' (G.collectPatBinders x) s x
+    hsBind x s = genericCT x s
+    genericCT x s = constrainedType' (collectBinders x) s x
+    collectBinders :: Data a => a -> [Id]
+    collectBinders = listifyStaged TypeChecker (const True)
     getType' x@(L spn _)
       | G.isGoodSrcSpan spn && spn `G.spans` lc
       = getType tcs x

From bca774826414557dcf238b72674f245059f76f4c Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Wed, 20 Jan 2016 03:11:50 +0300
Subject: [PATCH 12/13] [Type-constraints] Do not duplicate constraints

---
 Language/Haskell/GhcMod/SrcUtils.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 833624b..06cd873 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -24,6 +24,7 @@ import Outputable (PprStyle)
 import TcHsSyn (hsPatType)
 import Prelude
 import Control.Monad
+import Data.List (nub)
 import Control.Arrow
 import qualified Data.Map as M
 
@@ -72,7 +73,7 @@ collectSpansTypes withConstraints tcs lc =
         | otherwise = (maybeToList <$> getType' x, s)
     constrainedType pids s spn genTyp =
       let
-        ctys  = mapMaybe build pids
+        ctys  = mapMaybe build (nub pids)
         build x | Just cti <- x `M.lookup` s
                 = let
                     (preds', ctt) = getPreds cti

From 432f8bfd93aaff70fd28bac937e426fb2b4dda8b Mon Sep 17 00:00:00 2001
From: Nikolay Yakimov <root@livid.pp.ru>
Date: Mon, 14 Mar 2016 22:12:04 +0300
Subject: [PATCH 13/13] [Type-constraints] Comments on collectSpansTypes

Also some minor code cleaning
---
 Language/Haskell/GhcMod/SrcUtils.hs | 43 +++++++++++++++++++++++------
 1 file changed, 35 insertions(+), 8 deletions(-)

diff --git a/Language/Haskell/GhcMod/SrcUtils.hs b/Language/Haskell/GhcMod/SrcUtils.hs
index 06cd873..961bfae 100644
--- a/Language/Haskell/GhcMod/SrcUtils.hs
+++ b/Language/Haskell/GhcMod/SrcUtils.hs
@@ -41,50 +41,77 @@ instance HasType (LPat Id) where
 
 ----------------------------------------------------------------
 
+-- | Stores mapping from monomorphic to polymorphic types
 type CstGenQS = M.Map Var Type
+-- | Generic type to simplify SYB definition
 type CstGenQT a = forall m. GhcMonad m => a Id -> CstGenQS -> (m [(SrcSpan, Type)], CstGenQS)
 
 collectSpansTypes :: (GhcMonad m) => Bool -> G.TypecheckedModule -> (Int, Int) -> m [(SrcSpan, Type)]
 collectSpansTypes withConstraints tcs lc =
+  -- This walks AST top-down, left-to-right, while carrying CstGenQS down the tree
+  -- (but not left-to-right)
   everythingStagedWithContext TypeChecker M.empty (liftM2 (++))
     (return [])
     ((return [],)
-      `mkQ`  (hsBind    :: CstGenQT G.LHsBind)
-      `extQ` (genericCT :: CstGenQT G.LHsExpr)
-      `extQ` (genericCT :: CstGenQT G.LPat)
+      `mkQ`  (hsBind    :: CstGenQT G.LHsBind) -- matches on binds
+      `extQ` (genericCT :: CstGenQT G.LHsExpr) -- matches on expressions
+      `extQ` (genericCT :: CstGenQT G.LPat) -- matches on patterns
       )
     (G.tm_typechecked_source tcs)
   where
+    -- Helper function to insert mapping into CstGenQS
     insExp x = M.insert (G.abe_mono x) (G.varType $ G.abe_poly x)
+    -- If there is AbsBinds here, insert mapping into CstGenQS if needed
     hsBind (L _ G.AbsBinds{abs_exports = es'}) s
       | withConstraints = (return [], foldr insExp s es')
       | otherwise       = (return [], s)
+    -- Otherwise, it's the same as other cases
     hsBind x s = genericCT x s
-    genericCT x s = constrainedType' (collectBinders x) s x
+    -- Generic SYB function to get type
+    genericCT x s
+      | withConstraints
+      = (maybe [] (uncurry $ constrainedType (collectBinders x) s) <$> getType' x, s)
+      | otherwise = (maybeToList <$> getType' x, s)
+    -- Collects everything with Id from LHsBind, LHsExpr, or LPat
     collectBinders :: Data a => a -> [Id]
     collectBinders = listifyStaged TypeChecker (const True)
+    -- Gets monomorphic type with location
     getType' x@(L spn _)
       | G.isGoodSrcSpan spn && spn `G.spans` lc
       = getType tcs x
       | otherwise = return Nothing
-    constrainedType' pids s x
-        | withConstraints
-        = (maybe [] (uncurry $ constrainedType pids s) <$> getType' x, s)
-        | otherwise = (maybeToList <$> getType' x, s)
+    -- Gets constrained type
+    constrainedType :: [Var] -- ^ Binders in expression, i.e. anything with Id
+                    -> CstGenQS -- ^ Map from Id to polymorphic type
+                    -> SrcSpan -- ^ extent of expression, copied to result
+                    -> Type -- ^ monomorphic type
+                    -> [(SrcSpan, Type)] -- ^ result
     constrainedType pids s spn genTyp =
       let
+        -- runs build on every binder.
         ctys  = mapMaybe build (nub pids)
+        -- Computes constrained type for x. Returns (constraints, substitutions)
+        -- Substitutions are needed because type variables don't match
+        -- between polymorphic and monomorphic types.
+        -- E.g. poly type might be `Monad m => m ()`, while monomorphic might be `f ()`
         build x | Just cti <- x `M.lookup` s
                 = let
                     (preds', ctt) = getPreds cti
+                    -- list of type variables in monomorphic type
                     vts = listifyStaged TypeChecker G.isTyVar $ G.varType x
+                    -- list of type variables in polymorphic type
                     tvm = listifyStaged TypeChecker G.isTyVarTy ctt
                   in Just (preds', zip vts tvm)
                 | otherwise = Nothing
+        -- list of constraints
         preds = concatMap fst ctys
+        -- Type variable substitutions
         subs  = G.mkTopTvSubst $ concatMap snd ctys
+        -- Constrained type
         ty    = G.substTy subs $ G.mkFunTys preds genTyp
       in [(spn, ty)]
+    -- Splits a given type into list of constraints and simple type. Drops foralls.
+    getPreds :: Type -> ([Type], Type)
     getPreds x | G.isForAllTy x = getPreds $ G.dropForAlls x
                | Just (c, t) <- G.splitFunTy_maybe x
                , G.isPredTy c = first (c:) $ getPreds t