Integrated getInfo into LSP

4 files changed, 230 insertions, 205 deletions

diff --git a/src/getinfo.sig b/src/getinfo.sig
index 317b7e79..334e19f1 100644
--- a/src/getinfo.sig
+++ b/src/getinfo.sig
@@ -26,6 +26,11 @@
  *)
 
 signature GET_INFO = sig 
-    val getInfo: string (* file:row:col *) -> Print.PD.pp_desc
+    val getInfo:
+        ElabEnv.env ->
+        Elab.str' ->
+        string (* fileName *) ->
+        { line: int , character: int} ->
+        Print.PD.pp_desc
 end
     
diff --git a/src/getinfo.sml b/src/getinfo.sml
index 37c50928..7925aba3 100644
--- a/src/getinfo.sml
+++ b/src/getinfo.sml
@@ -73,198 +73,163 @@ fun getSpan (f: item * E.env) =
       | Str s => #2 s
       | Decl d => #2 d
 
-fun getInfo' file row col =
-    if not (!Elaborate.incremental)
-    then P.PD.string "ERROR: urweb daemon is needed to use typeOf command"
-    else
-        case ModDb.lookupModAndDepsIncludingErrored (Compiler.moduleOf file) of
-            NONE => P.PD.string ("ERROR: No module found: " ^ Compiler.moduleOf file)
-          | SOME (modDecl, deps) => 
-            let
-                val () = U.mliftConInCon := E.mliftConInCon
-
-                (* Adding signature of dependencies to environment *)
-                val env = List.foldl (fn (d, e) => E.declBinds e d) E.empty deps
-
-                (* Adding previous declarations in file to environment *)
-                (* "open <mod>" statements are already translated during elaboration *)
-                (*   They get added to the env here "unprefixed" *)
-                val env =
-                    case #1 modDecl of 
-                        L.DStr (name, _, sgn, str) =>
-                        (case #1 str of
-                             L.StrConst decls =>
-                             List.foldl (fn (d, env) =>
-                                            if #line (#first (#2 d)) <= row
-                                               andalso #char (#first (#2 d)) <= col
-                                            then E.declBinds env d
-                                            else env) env decls
-                           | _ => env)
-                      | L.DFfiStr _ => env
-                      | _ => env
-
-                (* Basis and Top need to be added to the env explicitly *)
-                val env =
-                    case ModDb.lookupModAndDepsIncludingErrored  "Top" of
-                        NONE => raise Fail "ERROR: Top module not found in ModDb"
-                      | SOME ((L.DStr (_, top_n, topSgn, topStr), _), _) => 
-                        #2 (Elaborate.dopen env {str = top_n, strs = [], sgn = topSgn})
-                      | _ => raise Fail "ERROR: Impossible"
-                val env =
-                    case ModDb.lookupModAndDepsIncludingErrored "Basis" of
-                        NONE => raise Fail "ERROR: Top module not found in ModDb"
-                      | SOME ((L.DFfiStr (_, basis_n, sgn), _), _) =>
-                        #2 (Elaborate.dopen env {str = basis_n, strs = [], sgn = sgn})
-                      | _ => raise Fail "ERROR: Impossible"
-
-                (* Just use ElabPrint functions. *)
-                (* These are better for compiler error message, but it's better than nothing *)
-                fun printLiterally {span = span, item = item, env = env} =
-                    P.box [ case item of
-                                Kind k => P.box [P.PD.string "KIND: ", ElabPrint.p_kind env k]
-                              | Con c => P.box [P.PD.string "CON: ", ElabPrint.p_con env c]
-                              | Exp e => P.box [P.PD.string "EXP: ", ElabPrint.p_exp env e]
-                              | Sgn_item si => P.box [P.PD.string "SGN_ITEM: ", ElabPrint.p_sgn_item env si]
-                              | Sgn s => P.box [P.PD.string "SGN: ", ElabPrint.p_sgn env s]
-                              | Str s => P.box [P.PD.string "STR: ", ElabPrint.p_str env s]
-                              | Decl d => P.box [P.PD.string "DECL: ", ElabPrint.p_decl env d]
-                          ]
-
-                (* TODO We lose some really useful information, like eg. inferred parameters, *)
-                (*   which we do have in the actual items (L.Decl, L.Exp, etc) *)
-                (*   but not when we do a lookup into the Env *)
-                (* TODO Rename? *)
-                fun printGoodPart env f span =
-                    (case f of
-                         Exp (L.EPrim p, _) =>
-                         SOME (P.box [Prim.p_t p,
-                                      P.PD.string ": ",
-                                      P.PD.string (case p of
-                                                       Prim.Int _ => "int"
-                                                     | Prim.Float _ => "float"
-                                                     | Prim.String _ => "string"
-                                                     | Prim.Char _ => "char")])
-                       | Exp (L.ERel n, _) =>
-                         SOME ((let val found = E.lookupERel env n
-                                in
-                                    P.box [ P.PD.string (#1 found)
-                                          , P.PD.string ": "
-                                          , ElabPrint.p_con env (#2 found)]
-                                end)
-                               handle E.UnboundRel _ => P.PD.string ("UNBOUND_REL" ^ Int.toString n))
-                       | Exp (L.ENamed n, _) =>
-                         SOME ((let val found = E.lookupENamed env n
-                                in
-                                    P.box [ P.PD.string (#1 found)
-                                          , P.PD.string ": "
-                                          , ElabPrint.p_con env (#2 found)]
-                                end)
-                               handle E.UnboundNamed _ => P.PD.string ("UNBOUND_NAMED" ^ Int.toString n))
-                       | Exp (L.EModProj ( m1 (* number (= "name") of top level module *)
-                                        , ms (* names of submodules - possibly none *)
-                                        , x (* identifier *)), loc) =>
-                         SOME (let
-                                  val (m1name, m1sgn) = E.lookupStrNamed env m1
-                                  val (str, sgn) = foldl (fn (m, (str, sgn)) =>
-                                                             case E.projectStr env {sgn = sgn, str = str, field = m} of
-                                                                 NONE => raise Fail ("Couldn't find Structure: " ^ m)
-                                                               | SOME sgn => ((L.StrProj (str, m), loc), sgn))
-                                                         ((L.StrVar m1, loc), m1sgn)
-                                                         ms
-                                  val t = case E.projectVal env {sgn = sgn, str = str, field = x} of
-                                              NONE => raise Fail ("Couldn't find identifier: " ^ x)
-                                            | SOME t => t
-                              in
-                                  P.box [ P.p_list_sep (P.PD.string ".") P.PD.string (m1name :: ms @ [x])
-                                        , P.PD.string ": "
-                                        , ElabPrint.p_con env t
-                                        ]
-                              end
-                               handle E.UnboundNamed _ => P.PD.string ("Module not found: " ^ Int.toString m1))
-                       | Exp e => NONE
-                       | Kind k => NONE
-                       | Con c => NONE
-                       | Sgn_item si => NONE
-                       | Sgn s => NONE
-                       | Str s => NONE
-                       | Decl d => NONE)
-
-                fun add env item span acc =
-                           if not (isPosIn file row col span)
-                           then
-                               acc
-                           else
-                               let
-                                   val smallest =
-                                       if isSmallerThan span (#span (#smallest acc))
-                                       then {span = span, item = item, env = env}
-                                       else #smallest acc
-                                   val smallestgoodpart =
-                                       case #smallestgoodpart acc of
-                                           NONE => 
-                                           (case printGoodPart env item span of
-                                                NONE => NONE
-                                              | SOME desc => SOME (desc, span))
-                                         | SOME (desc', span') => 
-                                           if isSmallerThan span span'
-                                           then 
-                                               (case printGoodPart env item span of
-                                                    NONE => SOME (desc', span')
-                                                  | SOME desc => SOME (desc, span))
-                                           else SOME (desc', span')
-                               in
-                                   {smallest = smallest, smallestgoodpart = smallestgoodpart}
-                               end
-
-                (* Look for item at input position *)
-                (* We're looking for two things simultaneously: *)
-                (* 1. The "smallest" part, ie. the one of which the source span is the smallest *)
-                (* 2. The "smallestgoodpart" part, ie. the one of which the source span is the smallest AND has a special case in printGoodPart *)
-                (* If we end up with a smallestgoodpart, we'll show that one since that one is probably more useful  *)
-                (* TODO source spans of XML and SQL sources are weird and you end *)
-                (*   up with eg: a span from eg 1-5 and another from 2-6, makes no sense? *)
-                (*   That's one of the reasons why we're searching for the two things mentioned above *)
-                val result =
-                    U.Decl.foldB
-                        { kind = fn (env, (k, span), acc) => add env (Kind (k, span)) span acc,
-                          con = fn (env, (k, span), acc) => add env (Con (k, span)) span acc,
-                          exp = fn (env, (k, span), acc) => add env (Exp (k, span)) span acc,
-                          sgn_item = fn (env, (k, span), acc) => add env (Sgn_item (k, span)) span acc,
-                          sgn = fn (env, (k, span), acc) => add env (Sgn (k, span)) span acc,
-                          str = fn (env, (k, span), acc) => add env (Str (k, span)) span acc,
-                          decl = fn (env, (k, span), acc) => add env (Decl (k, span)) span acc,
-                          bind = fn (env, binder) =>
-                                    case binder of
-                                        U.Decl.RelK x => E.pushKRel env x
-                                      | U.Decl.RelC (x, k) => E.pushCRel env x k
-                                      | U.Decl.NamedC (x, n, k, co) => E.pushCNamedAs env x n k co
-                                      | U.Decl.RelE (x, c) => E.pushERel env x c
-                                      | U.Decl.NamedE (x, c) => #1 (E.pushENamed env x c)
-                                      | U.Decl.Str (x, n, sgn) => #1 (E.pushStrNamed env x sgn)
-                                      | U.Decl.Sgn (x, n, sgn) => #1 (E.pushSgnNamed env x sgn)
-                        }
-                        env
-                        { smallestgoodpart = NONE
-                        , smallest = { item = Decl (#1 modDecl, { file = file
-                                                                , first = { line = 0, char = 0}
-                                                                , last = { line = 99999, char = 0} })
-                                     , span = { file = file
-                                              , first = { line = 0, char = 0}
-                                              , last = { line = 99999, char = 0} }
-                                     , env = env }
-                        }
-                        modDecl
-            in
-                case #smallestgoodpart result of
-                    NONE => printLiterally (#smallest result)
-                  | SOME (desc, span) => desc
-            end
-
-fun getInfo loc =
-    case String.tokens (fn ch => ch = #":") loc of
-        file :: rowStr :: colStr :: nil =>
-        (case (Int.fromString rowStr, Int.fromString colStr) of
-             (SOME row, SOME col) => getInfo' file row col
-           | _ => P.PD.string "ERROR: Wrong typeOf input format, should be <file:row:col>")
-      | _ => P.PD.string "ERROR: Wrong typeOf input format, should be <file:row:col>"
+fun getInfo env str fileName {line = row, character = col} =
+    let
+        val () = U.mliftConInCon := E.mliftConInCon
+
+        (* Adding previous declarations in file to environment *)
+        (* "open <mod>" statements are already translated during elaboration *)
+        (*   They get added to the env here "unprefixed" *)
+        val env = (case str of
+                       L.StrConst decls =>
+                       List.foldl (fn (d, env) =>
+                                      if #line (#first (#2 d)) <= row
+                                         andalso #char (#first (#2 d)) <= col
+                                      then E.declBinds env d
+                                      else env) env decls
+                     | _ => env)
+
+        (* Just use ElabPrint functions. *)
+        (* These are better for compiler error messages, but it's better than nothing *)
+        fun printLiterally {span = span, item = item, env = env} =
+            P.box [ case item of
+                        Kind k => P.box [P.PD.string "KIND: ", ElabPrint.p_kind env k]
+                      | Con c => P.box [P.PD.string "CON: ", ElabPrint.p_con env c]
+                      | Exp e => P.box [P.PD.string "EXP: ", ElabPrint.p_exp env e]
+                      | Sgn_item si => P.box [P.PD.string "SGN_ITEM: ", ElabPrint.p_sgn_item env si]
+                      | Sgn s => P.box [P.PD.string "SGN: ", ElabPrint.p_sgn env s]
+                      | Str s => P.box [P.PD.string "STR: ", ElabPrint.p_str env s]
+                      | Decl d => P.box [P.PD.string "DECL: ", ElabPrint.p_decl env d]
+                  ]
+
+        (* TODO We lose some really useful information, like eg. inferred parameters, *)
+        (*   which we do have in the actual items (L.Decl, L.Exp, etc) *)
+        (*   but not when we do a lookup into the Env *)
+        (* TODO Rename? *)
+        fun printGoodPart env f span =
+            (case f of
+                  Exp (L.EPrim p, _) =>
+                  SOME (P.box [Prim.p_t p,
+                              P.PD.string ": ",
+                              P.PD.string (case p of
+                                                Prim.Int _ => "int"
+                                              | Prim.Float _ => "float"
+                                              | Prim.String _ => "string"
+                                              | Prim.Char _ => "char")])
+                | Exp (L.ERel n, _) =>
+                  SOME ((let val found = E.lookupERel env n
+                        in
+                            P.box [ P.PD.string (#1 found)
+                                  , P.PD.string ": "
+                                  , ElabPrint.p_con env (#2 found)]
+                        end)
+                        handle E.UnboundRel _ => P.PD.string ("UNBOUND_REL" ^ Int.toString n))
+                | Exp (L.ENamed n, _) =>
+                  SOME ((let val found = E.lookupENamed env n
+                        in
+                            P.box [ P.PD.string (#1 found)
+                                  , P.PD.string ": "
+                                  , ElabPrint.p_con env (#2 found)]
+                        end)
+                        handle E.UnboundNamed _ => P.PD.string ("UNBOUND_NAMED" ^ Int.toString n))
+                | Exp (L.EModProj ( m1 (* number (= "name") of top level module *)
+                                , ms (* names of submodules - possibly none *)
+                                , x (* identifier *)), loc) =>
+                  SOME (let
+                          val (m1name, m1sgn) = E.lookupStrNamed env m1
+                          val (str, sgn) = foldl (fn (m, (str, sgn)) =>
+                                                      case E.projectStr env {sgn = sgn, str = str, field = m} of
+                                                          NONE => raise Fail ("Couldn't find Structure: " ^ m)
+                                                        | SOME sgn => ((L.StrProj (str, m), loc), sgn))
+                                                  ((L.StrVar m1, loc), m1sgn)
+                                                  ms
+                          val t = case E.projectVal env {sgn = sgn, str = str, field = x} of
+                                      NONE => raise Fail ("Couldn't find identifier: " ^ x)
+                                    | SOME t => t
+                      in
+                          P.box [ P.p_list_sep (P.PD.string ".") P.PD.string (m1name :: ms @ [x])
+                                , P.PD.string ": "
+                                , ElabPrint.p_con env t
+                                ]
+                      end
+                        handle E.UnboundNamed _ => P.PD.string ("Module not found: " ^ Int.toString m1))
+                | Exp e => NONE
+                | Kind k => NONE
+                | Con c => NONE
+                | Sgn_item si => NONE
+                | Sgn s => NONE
+                | Str s => NONE
+                | Decl d => NONE)
+
+        fun add env item span acc =
+                    if not (isPosIn fileName row col span)
+                    then
+                        acc
+                    else
+                        let
+                            val smallest =
+                                if isSmallerThan span (#span (#smallest acc))
+                                then {span = span, item = item, env = env}
+                                else #smallest acc
+                            val smallestgoodpart =
+                                case #smallestgoodpart acc of
+                                    NONE => 
+                                    (case printGoodPart env item span of
+                                        NONE => NONE
+                                      | SOME desc => SOME (desc, span))
+                                  | SOME (desc', span') => 
+                                    if isSmallerThan span span'
+                                    then 
+                                        (case printGoodPart env item span of
+                                            NONE => SOME (desc', span')
+                                          | SOME desc => SOME (desc, span))
+                                    else SOME (desc', span')
+                        in
+                            {smallest = smallest, smallestgoodpart = smallestgoodpart}
+                        end
+
+        (* Look for item at input position *)
+        (* We're looking for two things simultaneously: *)
+        (* 1. The "smallest" part, ie. the one of which the source span is the smallest *)
+        (* 2. The "smallestgoodpart" part, ie. the one of which the source span is the smallest AND has a special case in printGoodPart *)
+        (* If we end up with a smallestgoodpart, we'll show that one since that one is probably more useful  *)
+        (* TODO source spans of XML and SQL sources are weird and you end *)
+        (*   up with eg: a span from eg 1-5 and another from 2-6, makes no sense? *)
+        (*   That's one of the reasons why we're searching for the two things mentioned above *)
+        val result =
+            U.Decl.foldB
+                { kind = fn (env, (k, span), acc) => add env (Kind (k, span)) span acc,
+                  con = fn (env, (k, span), acc) => add env (Con (k, span)) span acc,
+                  exp = fn (env, (k, span), acc) => add env (Exp (k, span)) span acc,
+                  sgn_item = fn (env, (k, span), acc) => add env (Sgn_item (k, span)) span acc,
+                  sgn = fn (env, (k, span), acc) => add env (Sgn (k, span)) span acc,
+                  str = fn (env, (k, span), acc) => add env (Str (k, span)) span acc,
+                  decl = fn (env, (k, span), acc) => add env (Decl (k, span)) span acc,
+                  bind = fn (env, binder) =>
+                            case binder of
+                                U.Decl.RelK x => E.pushKRel env x
+                              | U.Decl.RelC (x, k) => E.pushCRel env x k
+                              | U.Decl.NamedC (x, n, k, co) => E.pushCNamedAs env x n k co
+                              | U.Decl.RelE (x, c) => E.pushERel env x c
+                              | U.Decl.NamedE (x, c) => #1 (E.pushENamed env x c)
+                              | U.Decl.Str (x, n, sgn) => #1 (E.pushStrNamed env x sgn)
+                              | U.Decl.Sgn (x, n, sgn) => #1 (E.pushSgnNamed env x sgn)
+                }
+                env
+                { smallestgoodpart = NONE
+                , smallest = { item = Str (str, { file = fileName
+                                                , first = { line = 0, char = 0}
+                                                , last = { line = 99999, char = 0} })
+                             , span = { file = fileName
+                                      , first = { line = 0, char = 0}
+                                      , last = { line = 99999, char = 0} }
+                             , env = env }
+                }
+                ( L.DStr (Compiler.moduleOf "fileName", 0, (L.SgnError, ErrorMsg.dummySpan), (str, {file = fileName, first = ErrorMsg.dummyPos, last = ErrorMsg.dummyPos}))
+                , {file = fileName, first = ErrorMsg.dummyPos, last = ErrorMsg.dummyPos})
+    in
+        case #smallestgoodpart result of
+            NONE => printLiterally (#smallest result)
+          | SOME (desc, span) => desc
+    end
 end
diff --git a/src/lsp.sml b/src/lsp.sml
index b5a92683..cfdec863 100644
--- a/src/lsp.sml
+++ b/src/lsp.sml
@@ -417,7 +417,8 @@ end
 structure SM = BinaryMapFn(SK)
 
 type fileState =
-     { decls : Elab.decl list }
+     { envBeforeThisModule: ElabEnv.env
+     , decls : Elab.decl list }
 type state =
      { urpPath : string
      , fileStates : fileState SM.map
@@ -572,10 +573,17 @@ fun calculateFileState (state: state) (fileName: string): (fileState option * Ls
             (* Parsing of .ur succeeded *)
             let 
                 val loc = {file = fileName, first = ErrorMsg.dummyPos, last = ErrorMsg.dummyPos}
+                val envBeforeThisModule = ref ElabEnv.empty
                 val res = Elaborate.elabFile
                               parsedBasisUrs tm1 parsedTopUr parsedTopUrs tm2 ElabEnv.empty
                               (* Adding urs's of previous modules to env *)
-                              (fn envB => List.foldl (fn (sgn, env) => addSgnToEnv env (#parsed sgn) (#fileName sgn) false) envB parsedUrss)
+                              (fn envB =>
+                                  let 
+                                      val newEnv = List.foldl (fn (sgn, env) => addSgnToEnv env (#parsed sgn) (#fileName sgn) false) envB parsedUrss
+                                  in
+                                      (envBeforeThisModule := newEnv; newEnv)
+                                  end
+                              )
                               [( Source.DStr (C.moduleOf fileName, parsedUrs, NONE, (Source.StrConst parsedUr, loc), false)
                                , loc )]
                 (* report back errors (as Diagnostics) *)
@@ -584,7 +592,7 @@ fun calculateFileState (state: state) (fileName: string): (fileState option * Ls
                                 (Elab.DStr (_, _, _, (Elab.StrConst decls, _)), _) => decls
                               | _ => raise Fail ("Impossible: Source.StrConst did not become Elab.StrConst after elaboration")
             in 
-                (SOME { decls = decls },
+                (SOME { envBeforeThisModule = !envBeforeThisModule, decls = decls },
                  List.map errorToDiagnostic errors)
             end
     end
@@ -605,6 +613,59 @@ fun handleFullDocument (state: state) (toclient: LspSpec.toclient) (documentUri:
         #publishDiagnostics toclient { uri = documentUri , diagnostics = #2 res}
     end
 
+fun scanDir (f: string -> bool) (path: string) =
+    let
+        val dir = OS.FileSys.openDir path
+        fun doScanDir acc =
+            case OS.FileSys.readDir dir of 
+                NONE => (OS.FileSys.closeDir dir; acc)
+             |  SOME fname =>
+                (if f fname
+                 then doScanDir (fname :: acc)
+                 else doScanDir acc)
+    in
+        doScanDir []
+    end
+
+fun readFile (fileName: string): string =
+    let 
+        val str = TextIO.openIn fileName
+        fun doReadFile acc = 
+            case TextIO.inputLine str of
+                NONE => acc
+              | SOME str => (str ^ "\n" ^ acc)
+        val res = doReadFile ""
+    in 
+        (TextIO.closeIn str; res)
+    end
+        
+
+fun handleHover (state: state) (p: LspSpec.hoverReq): LspSpec.hoverResp LspSpec.result =
+    let
+        val fileName = #path (#uri (#textDocument p))
+        val s = SM.find (#fileStates state, fileName)
+    in
+        case s of
+            NONE => LspSpec.Success NONE
+          | SOME s =>
+            let 
+                val env = #envBeforeThisModule s
+                val decls = #decls s
+                val loc = #position p
+                val pp = GetInfo.getInfo env (Elab.StrConst decls) fileName { line = #line loc + 1
+                                                                            , character = #character loc + 1} 
+                (* TODO I couldn't figure out how to print just to a string, so writing to a temp file, then reading it, then deleting it, ... *)
+                val tempfile = OS.FileSys.tmpName ()
+                val outStr = TextIO.openOut tempfile
+                val outDev = TextIOPP.openOut {dst = outStr, wid = 70}
+                val () = Print.fprint outDev pp
+                val res = readFile tempfile
+                val () = TextIO.closeOut outStr
+            in
+                LspSpec.Success (SOME {contents = res})
+            end
+    end
+
 fun serverLoop () =            
     let 
         val requestMessage =
@@ -653,7 +714,7 @@ fun serverLoop () =
                   m
                   { initialize = fn _ => LspSpec.Error (~32600, "Server already initialized")
                   , shutdown = fn () => LspSpec.Success ()
-                  , textDocument_hover = fn ctx => fn _ => LspSpec.Success NONE
+                  , textDocument_hover = fn ctx => fn p => handleHover state p
                   })
                  handle LspError e => handleLspErrorInRequest (#id m) e
                       | ex => handleLspErrorInRequest (#id m) (InternalError (General.exnMessage ex)))
diff --git a/src/main.mlton.sml b/src/main.mlton.sml
index 1747d702..9042307a 100644
--- a/src/main.mlton.sml
+++ b/src/main.mlton.sml
@@ -141,10 +141,6 @@ fun oneRun args =
         fun printModuleOf fname =
             print_and_exit (Compiler.moduleOf fname) ()
 
-        fun getInfo loc =
-            (Print.print (GetInfo.getInfo loc);
-             raise Code OS.Process.success)
-
         fun add_class (class, num) =
             case Int.fromString num of
                  NONE => raise Fail ("Invalid limit number '" ^ num ^ "'")
@@ -251,8 +247,6 @@ fun oneRun args =
                     NONE),
               ("moduleOf", ONE ("<file>", printModuleOf),
                     SOME "print module name of <file> and exit"),
-              ("getInfo", ONE ("<file:row:col>", getInfo),
-                    SOME "print info of expression at <file:row:col> and exit"),
               ("startLspServer", ZERO Lsp.startServer, SOME "Start Language Server Protocol server"),
               ("noEmacs", set_true Demo.noEmacs,
                     NONE),