Plumb the runtime through to the codebase server, so it can evaluate expressions in docs

Have one remaining todo to fetch decl headers for search results

parser-typechecker/src/Unison/CommandLine/Main.hs

@@ -39,7 +39,6 @@ import qualified Unison.Codebase.Path as Path
 import qualified Unison.Codebase.Runtime as Runtime
 import qualified Unison.Codebase as Codebase
 import qualified Unison.CommandLine.InputPattern as IP
-import qualified Unison.Runtime.Interface      as RTI
 import qualified Unison.Util.Pretty as P
 import qualified Unison.Util.TQueue as Q
 import Text.Regex.TDFA
@@ -157,10 +156,11 @@ main
   -> Path.Absolute
   -> (Config, IO ())
   -> [Either Event Input]
+  -> Runtime.Runtime Symbol
   -> Codebase IO Symbol Ann
   -> String
   -> IO ()
-main dir defaultBaseLib initialPath (config,cancelConfig) initialInputs codebase version = do
+main dir defaultBaseLib initialPath (config,cancelConfig) initialInputs runtime codebase version = do
   dir' <- shortenDirectory dir
   root <- fromMaybe Branch.empty . rightMay <$> Codebase.getRootBranch codebase
   putPrettyLn $ case defaultBaseLib of
@@ -169,7 +169,6 @@ main dir defaultBaseLib initialPath (config,cancelConfig) initialInputs codebase
       _ -> welcomeMessage dir' version
   eventQueue <- Q.newIO
   do
-    runtime                  <- RTI.startRuntime
     -- we watch for root branch tip changes, but want to ignore ones we expect.
     rootRef                  <- newIORef root
     pathRef                  <- newIORef initialPath

parser-typechecker/src/Unison/Server/Backend.hs

@@ -260,6 +260,20 @@ typeListEntry codebase r n = do
     _ -> pure Data
   pure $ TypeEntry r n tag
 
+typeDeclHeader
+  :: Monad m
+  => Var v
+  => Codebase m v Ann
+  -> PPE.PrettyPrintEnv
+  -> Reference
+  -> Backend m (DisplayObject Syntax.SyntaxText)
+typeDeclHeader code ppe r = undefined code r ppe "todo"
+-- prettyDeclOrBuiltinHeader
+--   :: Var v
+--   => HashQualified Name
+--   -> DD.DeclOrBuiltin v a
+--   -> Pretty SyntaxText
+
 termEntryToNamedTerm
   :: Var v => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
 termEntryToNamedTerm ppe typeWidth (TermEntry r name mayType tag) = NamedTerm
@@ -536,17 +550,16 @@ mungeSyntaxText
 mungeSyntaxText = fmap Syntax.convertElement
 
 prettyDefinitionsBySuffixes
-  :: forall v m
-   . Monad m
-  => Var v
+  :: forall v
+   . Var v
   => Maybe Path
   -> Maybe Branch.Hash
   -> Maybe Width
   -> Suffixify
   -> Rt.Runtime v
-  -> Codebase m v Ann
+  -> Codebase IO v Ann
   -> [HQ.HashQualified Name]
-  -> Backend m DefinitionDisplayResults
+  -> Backend IO DefinitionDisplayResults
 prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt codebase query
   = do
     branch                               <- resolveBranchHash root codebase
@@ -584,7 +597,7 @@ prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt cod
       docNames hqs = fmap docify . nubOrd . join . map toList . Set.toList $ hqs
         where docify n = Name.joinDot n "doc"
 
-      selectDocs :: [Referent] -> Backend m [Reference]
+      selectDocs :: [Referent] -> Backend IO [Reference]
       selectDocs rs = do
         rts <- fmap join . for rs $ \case
           Referent.Ref r ->
@@ -592,7 +605,7 @@ prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt cod
           _ -> pure []
         pure [ r | (r, t) <- rts, Typechecker.isSubtype t (Type.ref mempty DD.doc2Ref) ]
 
-      renderDoc :: Reference -> Backend m [(HashQualifiedName, UnisonHash, Doc.Doc)]
+      renderDoc :: Reference -> Backend IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
       renderDoc r = do
         let name = bestNameForTerm @v (PPE.suffixifiedPPE ppe) width (Referent.Ref r)
         let hash = Reference.toText r
@@ -605,7 +618,7 @@ prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt cod
             fmap Term.unannotate <$> lift (Codebase.getTerm codebase r)
 
           typeOf r = fmap void <$> lift (Codebase.getTypeOfReferent codebase r)
-          eval tm = do
+          eval (Term.amap (const mempty) -> tm) = do
             let ppes = PPE.suffixifiedPPE ppe
             let codeLookup = Codebase.toCodeLookup codebase
             let cache r = fmap Term.unannotate <$> Codebase.lookupWatchCache codebase r
@@ -615,12 +628,12 @@ prettyDefinitionsBySuffixes relativeTo root renderWidth suffixifyBindings rt cod
                              (Term.hashClosedTerm tm)
                              (Term.amap (const mempty) tmr)
               Nothing -> pure ()
-            pure $ r <&> Term.unannotate
+            pure $ r <&> Term.amap (const mempty)
 
           decls (Reference.DerivedId r) = fmap (DD.amap (const ())) <$> lift (Codebase.getTypeDeclaration codebase r)
           decls _ = pure Nothing
 
-      docResults :: [Name] -> Backend m [(HashQualifiedName, UnisonHash, Doc.Doc)]
+      docResults :: [Name] -> Backend IO [(HashQualifiedName, UnisonHash, Doc.Doc)]
       docResults docs = fmap join . for docs $ \name -> do
         -- resolve each name to (0 or more) references
         rs <- pure . Set.toList $ Names3.lookupHQTerm (HQ.NameOnly name) parseNames
@@ -699,7 +712,7 @@ resolveBranchHash h codebase = case h of
 
 definitionsBySuffixes
   :: forall m v
-   . Monad m
+   . (MonadIO m)
   => Var v
   => Maybe Path
   -> Branch m

parser-typechecker/src/Unison/Server/CodebaseServer.hs

@@ -92,6 +92,7 @@ import System.FilePath ((</>))
 import qualified System.FilePath as FilePath
 import System.Random.Stateful (getStdGen, newAtomicGenM, uniformByteStringM)
 import Unison.Codebase (Codebase)
+import qualified Unison.Codebase.Runtime as Rt
 import Unison.Parser (Ann)
 import Unison.Prelude
 import Unison.Server.Endpoints.FuzzyFind (FuzzyFindAPI, serveFuzzyFind)
@@ -166,12 +167,13 @@ serverAPI = Proxy
 
 app
   :: Var v
-  => Codebase IO v Ann
+  => Rt.Runtime v
+  -> Codebase IO v Ann
   -> FilePath
   -> Strict.ByteString
   -> Application
-app codebase uiPath expectedToken =
-  serve serverAPI $ server codebase uiPath expectedToken
+app rt codebase uiPath expectedToken =
+  serve serverAPI $ server rt codebase uiPath expectedToken
 
 genToken :: IO Strict.ByteString
 genToken = do
@@ -208,10 +210,11 @@ ucmTokenVar = "UCM_TOKEN"
 -- The auth token required for accessing the server is passed to the function k
 start
   :: Var v
-  => Codebase IO v Ann
+  => Rt.Runtime v
+  -> Codebase IO v Ann
   -> (Strict.ByteString -> Port -> IO ())
   -> IO ()
-start codebase k = do
+start rt codebase k = do
   envToken <- lookupEnv ucmTokenVar
   envHost  <- lookupEnv ucmHostVar
   envPort  <- (readMaybe =<<) <$> lookupEnv ucmPortVar
@@ -253,19 +256,20 @@ start codebase k = do
     mayOpts =
       getParseResult $ execParserPure defaultPrefs (info p forwardOptions) args
   case mayOpts of
-    Just (_, token, host, port, ui) -> startServer codebase k token host port ui
-    Nothing -> startServer codebase k Nothing Nothing Nothing Nothing
+    Just (_, token, host, port, ui) -> startServer rt codebase k token host port ui
+    Nothing -> startServer rt codebase k Nothing Nothing Nothing Nothing
 
 startServer
   :: Var v
-  => Codebase IO v Ann
+  => Rt.Runtime v
+  -> Codebase IO v Ann
   -> (Strict.ByteString -> Port -> IO ())
   -> Maybe String
   -> Maybe String
   -> Maybe Port
   -> Maybe String
   -> IO ()
-startServer codebase k envToken envHost envPort envUI0 = do
+startServer rt codebase k envToken envHost envPort envUI0 = do
   -- the `canonicalizePath` resolves symlinks
   exePath <- canonicalizePath =<< getExecutablePath
   envUI <- canonicalizePath $ fromMaybe (FilePath.takeDirectory exePath </> "ui") envUI0
@@ -277,7 +281,7 @@ startServer codebase k envToken envHost envPort envUI0 = do
         <> foldMap (Endo . setHost . fromString) envHost
         )
         defaultSettings
-      a = app codebase envUI token
+      a = app rt codebase envUI token
   case envPort of
     Nothing -> withApplicationSettings settings (pure a) (k token)
     Just p  -> do
@@ -311,16 +315,17 @@ serveUI tryAuth path _ = tryAuth *> serveIndex path
 
 server
   :: Var v
-  => Codebase IO v Ann
+  => Rt.Runtime v
+  -> Codebase IO v Ann
   -> FilePath
   -> Strict.ByteString
   -> Server AuthedServerAPI
-server codebase uiPath token =
+server rt codebase uiPath token =
   serveDirectoryWebApp (uiPath </> "static")
     :<|> ((\t ->
             serveUI (tryAuth t) uiPath
               :<|> (    (    (serveNamespace (tryAuth t) codebase)
-                        :<|> (serveDefinitions (tryAuth t) codebase)
+                        :<|> (serveDefinitions (tryAuth t) rt codebase)
                         :<|> (serveFuzzyFind (tryAuth t) codebase)
                         )
                    :<|> serveOpenAPI

parser-typechecker/src/Unison/Server/Endpoints/FuzzyFind.hs

@@ -15,7 +15,6 @@ import Control.Lens (view, _1)
 import Data.Aeson
 import Data.Function (on)
 import Data.List (sortBy)
-import qualified Data.Map as Map
 import Data.OpenApi (ToSchema)
 import Data.Ord (Down (..))
 import qualified Data.Text as Text
@@ -40,12 +39,10 @@ import qualified Unison.Codebase.Branch as Branch
 import Unison.Codebase.Editor.DisplayObject
 import qualified Unison.Codebase.Path as Path
 import qualified Unison.Codebase.ShortBranchHash as SBH
-import qualified Unison.HashQualified as HQ
 import qualified Unison.HashQualified' as HQ'
 import Unison.NameSegment
 import Unison.Parser (Ann)
 import Unison.Prelude
-import qualified Unison.Reference as Reference
 import qualified Unison.Server.Backend as Backend
 import Unison.Server.Errors
   ( backendError,
@@ -55,12 +52,9 @@ import Unison.Server.Syntax (SyntaxText)
 import Unison.Server.Types
   ( APIGet,
     APIHeaders,
-    DefinitionDisplayResults (..),
     HashQualifiedName,
     NamedTerm,
     NamedType,
-    Suffixify (..),
-    TypeDefinition (..),
     addHeaders,
     mayDefault,
   )
@@ -165,9 +159,9 @@ serveFuzzyFind h codebase mayRoot relativePath limit typeWidth query =
       join <$> traverse (loadEntry root (Just rel) ppe b0) alignments
     errFromEither backendError ea
  where
-  loadEntry root rel ppe b0 (a, (HQ'.NameOnly . NameSegment) -> n, refs) =
-    traverse
-      (\case
+  loadEntry _root _rel ppe b0 (a, (HQ'.NameOnly . NameSegment) -> n, refs) =
+    for refs $
+      \case
         Backend.FoundTermRef r ->
           (\te ->
               ( a
@@ -179,27 +173,12 @@ serveFuzzyFind h codebase mayRoot relativePath limit typeWidth query =
             )
             <$> Backend.termListEntry codebase b0 r n
         Backend.FoundTypeRef r -> do
-          te                              <- Backend.typeListEntry codebase r n
-          DefinitionDisplayResults _ ts _ <- Backend.prettyDefinitionsBySuffixes
-            rel
-            root
-            typeWidth
-            (Suffixify True)
-            codebase
-            [HQ.HashOnly $ Reference.toShortHash r]
-          let
-            t  = Map.lookup (Reference.toText r) ts
-            td = case t of
-              Just t -> t
-              Nothing ->
-                TypeDefinition mempty mempty Nothing (MissingObject (Reference.toShortHash r)) mempty
-            namedType = Backend.typeEntryToNamedType te
-          pure
-            ( a
-            , FoundTypeResult
-              $ FoundType (bestTypeName td) (typeDefinition td) namedType
-            )
-      )
-      refs
+          te <- Backend.typeListEntry codebase r n
+          let namedType = Backend.typeEntryToNamedType te
+          let typeName = Backend.bestNameForType @v ppe (mayDefault typeWidth) r
+          typeHeader <- Backend.typeDeclHeader codebase ppe r
+          let ft = FoundType typeName typeHeader namedType
+          pure (a, FoundTypeResult ft)
+
   parsePath p = errFromEither (`badNamespace` p) $ Path.parsePath' p
   errFromEither f = either (throwError . f) pure

parser-typechecker/src/Unison/Server/Endpoints/GetDefinitions.hs

@@ -24,6 +24,7 @@ import Servant.Docs
 import Servant.Server (Handler)
 import Unison.Codebase (Codebase)
 import qualified Unison.Codebase.Path as Path
+import qualified Unison.Codebase.Runtime as Rt
 import Unison.Codebase.ShortBranchHash
   ( ShortBranchHash,
   )
@@ -108,6 +109,7 @@ instance ToSample DefinitionDisplayResults where
 serveDefinitions
   :: Var v
   => Handler ()
+  -> Rt.Runtime v
   -> Codebase IO v Ann
   -> Maybe ShortBranchHash
   -> Maybe HashQualifiedName
@@ -115,7 +117,7 @@ serveDefinitions
   -> Maybe Width
   -> Maybe Suffixify
   -> Handler (APIHeaders DefinitionDisplayResults)
-serveDefinitions h codebase mayRoot relativePath hqns width suff =
+serveDefinitions h rt codebase mayRoot relativePath hqns width suff =
   addHeaders <$> do
     h
     rel <-
@@ -126,6 +128,7 @@ serveDefinitions h codebase mayRoot relativePath hqns width suff =
                                           root
                                           width
                                           (fromMaybe (Suffixify True) suff)
+                                          rt
                                           codebase
         $   HQ.unsafeFromText
         <$> hqns

parser-typechecker/unison/Main.hs

@@ -45,6 +45,7 @@ import Unison.CommandLine (plural', watchConfig)
 import qualified Unison.CommandLine.Main as CommandLine
 import Unison.Parser (Ann)
 import Unison.Prelude
+import qualified Unison.Codebase.Runtime as Rt
 import qualified Unison.PrettyTerminal as PT
 import qualified Unison.Runtime.Interface as RTI
 import qualified Unison.Server.CodebaseServer as Server
@@ -185,8 +186,9 @@ main = do
         Left _ -> PT.putPrettyLn $ P.callout "⚠️" "I couldn't find that file or it is for some reason unreadable."
         Right contents -> do
           (closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
+          rt <- RTI.startRuntime
           let fileEvent = Input.UnisonFileChanged (Text.pack file) contents
-          launch currentDir config theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName, Right Input.QuitI]
+          launch currentDir config rt theCodebase [Left fileEvent, Right $ Input.ExecuteI mainName, Right Input.QuitI]
           closeCodebase
     "run.pipe" : [mainName] -> do
       e <- safeReadUtf8StdIn
@@ -194,9 +196,10 @@ main = do
         Left _ -> PT.putPrettyLn $ P.callout "⚠️" "I had trouble reading this input."
         Right contents -> do
           (closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
+          rt <- RTI.startRuntime
           let fileEvent = Input.UnisonFileChanged (Text.pack "<standard input>") contents
           launch
-            currentDir config theCodebase
+            currentDir config rt theCodebase
             [Left fileEvent, Right $ Input.ExecuteI mainName, Right Input.QuitI]
           closeCodebase
     "transcript" : args' ->
@@ -211,7 +214,8 @@ main = do
     args -> do
       let headless = listToMaybe args == Just "headless"
       (closeCodebase, theCodebase) <- getCodebaseOrExit cbFormat mcodepath
-      Server.start theCodebase $ \token port -> do
+      runtime <- RTI.startRuntime
+      Server.start runtime theCodebase $ \token port -> do
         let url =
              "http://127.0.0.1:" <> show port <> "/" <> URI.encode (unpack token)
         when headless $
@@ -229,7 +233,7 @@ main = do
           takeMVar mvar
         else do
           PT.putPrettyLn $ P.string "Now starting the Unison Codebase Manager..."
-          launch currentDir config theCodebase []
+          launch currentDir config runtime theCodebase []
           closeCodebase
 
 upgradeCodebase :: Maybe Codebase.CodebasePath -> IO ()
@@ -338,11 +342,12 @@ initialPath = Path.absoluteEmpty
 launch
   :: FilePath
   -> (Config, IO ())
-  -> _
+  -> Rt.Runtime Symbol
+  -> Codebase.Codebase IO Symbol Ann
   -> [Either Input.Event Input.Input]
   -> IO ()
-launch dir config code inputs =
-  CommandLine.main dir defaultBaseLib initialPath config inputs code Version.gitDescribe
+launch dir config rt code inputs =
+  CommandLine.main dir defaultBaseLib initialPath config inputs rt code Version.gitDescribe
 
 isMarkdown :: String -> Bool
 isMarkdown md = case FP.takeExtension md of