From 415ff70898b3de9bc697a3c7f8384856626ee3b7 Mon Sep 17 00:00:00 2001
From: Paul Chiusano <paul.chiusano@gmail.com>
Date: Tue, 27 Oct 2015 12:19:11 -0400
Subject: [PATCH] fix issue with DFO instantiation tracking of path info

---
 shared/src/Unison/Doc.hs         | 7 +++++++
 shared/src/Unison/Term.hs        | 2 +-
 shared/tests/Unison/Test/Term.hs | 9 ++++++++-
 3 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/shared/src/Unison/Doc.hs b/shared/src/Unison/Doc.hs
index bf37f45a6..d8228d03b 100644
--- a/shared/src/Unison/Doc.hs
+++ b/shared/src/Unison/Doc.hs
@@ -589,6 +589,13 @@ debugDoc (p :< l) = show p : case l of
   Group r -> debugDoc r
   _ -> []
 
+leafPaths :: Path p => Doc e p -> [p]
+leafPaths (p :< d) = map (Path.extend p) $ case d of
+  Append a b -> leafPaths a ++ leafPaths b
+  Nest _ r -> leafPaths r
+  Group r -> leafPaths r
+  _ -> [Path.root]
+
 -- various instances
 
 instance Bifunctor L where
diff --git a/shared/src/Unison/Term.hs b/shared/src/Unison/Term.hs
index ff621dfcb..612dc60ae 100644
--- a/shared/src/Unison/Term.hs
+++ b/shared/src/Unison/Term.hs
@@ -368,7 +368,7 @@ view ref t = go no View.low t where
       let
         Symbol.Symbol _ name view = op fn
         (taken, remaining) = splitAt (View.arity view) args
-        fmt (child,path) = (\p -> D.sub' path (go (fn ==) p child), path)
+        fmt (child,path) = (\p -> go (fn ==) p child, path)
         applied = fromMaybe unsaturated (View.instantiate view fnP name (map fmt taken))
         unsaturated = D.sub' fnP $ go no View.high fn
       in
diff --git a/shared/tests/Unison/Test/Term.hs b/shared/tests/Unison/Test/Term.hs
index f0b29a6c1..b8ebbea6a 100644
--- a/shared/tests/Unison/Test/Term.hs
+++ b/shared/tests/Unison/Test/Term.hs
@@ -39,11 +39,18 @@ tests = withResource Common.node (\_ -> pure ()) $ \node -> testGroup "Term"
     , testCase "hash cycles" $ assertEqual "pingpong"
        (hash pingpong1)
        (hash pingpong2)
-    , testCase "infix-rendering" $ node >>= \(_,symbol) ->
+    , testCase "infix-rendering (1)" $ node >>= \(_,symbol) ->
         let t = num 1 `plus` num 1
         in assertEqual "+"
           "1 + 1"
           (Doc.formatText (Width 80) (view symbol t))
+    , testCase "infix-rendering (2)" $ node >>= \(_,symbol) ->
+        do
+          t <- pure $ num 1 `plus` num 1
+          let d = view symbol t
+          assertEqual "path sanity check"
+             [Fn,Arg]
+             (head $ Doc.leafPaths d)
     ]
 
 -- various unison terms, useful for testing