Add global file search

backend/app/Main.hs

@@ -29,6 +29,7 @@ import Handlers.Agent (
  )
 import Handlers.Autocomplete (autocompleteHandler)
 import Handlers.CommitHash (getCommitHashHandler)
+import Handlers.FileIndex (fileIndexHandler)
 import Handlers.Presets (getPresetsHandler)
 import Handlers.ProjectEntities (assignRecordHandler, batchAssignRecordsHandler, unassignRecordHandler)
 import Handlers.Projects (deleteProjectHandler, getProjectsHandler, patchProjectHandler, postProjectHandler)
@@ -68,6 +69,7 @@ server =
         :<|> saveSrcFileHandler
         :<|> createSrcFileHandler
         :<|> deleteSrcFileHandler
+        :<|> fileIndexHandler
         :<|> getProjectsHandler
         :<|> postProjectHandler
         :<|> patchProjectHandler
@@ -194,6 +196,13 @@ corsPolicy req = case pathInfo req of
                 , corsMethods = ["GET", "OPTIONS"]
                 , corsOrigins = Nothing
                 }
+    ["file-index"] ->
+        Just $
+            simpleCorsResourcePolicy
+                { corsRequestHeaders = ["Content-Type"]
+                , corsMethods = ["GET", "OPTIONS"]
+                , corsOrigins = Nothing
+                }
     ["autocomplete"] ->
         Just $
             simpleCorsResourcePolicy

backend/backend.cabal

@@ -29,6 +29,7 @@ library
     Handlers.CommitHash
     Handlers.ClusterStream
     Handlers.Download
+    Handlers.FileIndex
     Handlers.Presets
     Handlers.ProjectEntities
     Handlers.Projects

backend/src/Api.hs

@@ -11,6 +11,7 @@ import qualified Data.ByteString as BS
 import Data.Text (Text)
 import Handlers.Agent (ConfirmApplyRequest, RenameSessionRequest, SessionRequest, TurnRequest)
 import Handlers.Autocomplete (AutocompleteRequest)
+import Handlers.FileIndex (FileIndexEntry)
 import Handlers.Projects (RawJSON)
 import Handlers.SrcFiles (UserRepoInfo)
 import Handlers.StatusStream (EventStream)
@@ -74,6 +75,12 @@ type DeleteSrcFile =
         :> QueryParam' '[Required] "path" FilePath
         :> Delete '[JSON] NoContent
 
+type GetFileIndex =
+    "file-index"
+        :> Description "Returns the global index of filenames across all project steps."
+        :> QueryParam "commit" Text
+        :> Get '[JSON] [FileIndexEntry]
+
 type DeleteProject =
     "projects"
         :> Description "Deletes a project record."
@@ -373,6 +380,7 @@ type API =
         :<|> UpdateSrcFile
         :<|> CreateSrcFile
         :<|> DeleteSrcFile
+        :<|> GetFileIndex
         :<|> GetProjects
         :<|> CreateProject
         :<|> UpdateProject

backend/src/Docs/OpenApi.hs

@@ -29,6 +29,7 @@ import GHC.Exts (fromList, toList)
 import GHC.TypeLits (KnownSymbol)
 import Handlers.Agent (ConfirmApplyRequest, RenameSessionRequest, SessionRequest, TurnRequest)
 import Handlers.Autocomplete (AutocompleteRequest)
+import Handlers.FileIndex (FileIndexEntry)
 import Handlers.SrcFiles (UserRepoInfo)
 import Handlers.Store (ByteOffset, DirEntry, FileChunk, LineOffset)
 import Network.HTTP.Media ((//))
@@ -135,6 +136,7 @@ instance ToSchema ByteOffset where
 
 instance ToSchema DirEntry
 instance ToSchema FileChunk
+instance ToSchema FileIndexEntry
 instance ToSchema UserRepoInfo
 instance ToSchema AutocompleteRequest
 instance ToSchema PreparedApply

backend/src/Handlers/FileIndex.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Handlers.FileIndex (FileIndexEntry (..), fileIndexHandler) where
+
+import Control.Monad.Except (ExceptT, runExceptT, throwError, withExceptT)
+import Control.Monad.IO.Class (liftIO)
+import Data.Aeson (ToJSON, eitherDecode)
+import Data.List (isPrefixOf, sort)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import Data.Text (Text, pack, unpack)
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
+import GHC.Generics (Generic)
+import Handlers.Store (resolveCommitHash)
+import OutPaths (ProjectDef (..), StepDef (..), StepRef (..), getProjectOutPaths)
+import Servant (Handler, ServerError (..), err500)
+import System.Directory (canonicalizePath, doesDirectoryExist, doesFileExist, listDirectory)
+import System.FilePath ((</>))
+import UserRepo (ReadRepoContext (..), runNixEvalJsonInRepo, runNixEvalRawInRepo, userRepoPath)
+
+data FileIndexEntry = FileIndexEntry
+    { projectId :: Int
+    , stepId :: Int
+    , target :: Text
+    , path :: [String]
+    }
+    deriving (Generic, ToJSON)
+
+fileIndexHandler :: Maybe Text -> Handler [FileIndexEntry]
+fileIndexHandler mCommit = do
+    repoPath <- liftIO userRepoPath
+    commit <- resolveCommitHash mCommit
+    entries <- liftIO $ runExceptT $ fileIndexAt $ ReadRepoContext repoPath commit
+    either (\message -> throwError err500{errBody = TLE.encodeUtf8 $ TL.pack message}) pure entries
+
+fileIndexAt :: ReadRepoContext -> ExceptT String IO [FileIndexEntry]
+fileIndexAt ctx = do
+    projectsJson <- evalAttr runNixEvalJsonInRepo "#pointy.projects"
+    projects <- case eitherDecode (TLE.encodeUtf8 (TL.pack projectsJson)) of
+        Left err -> throwError $ "decoding #pointy.projects failed: " ++ err
+        Right defs -> pure (defs :: Map String ProjectDef)
+    srcFilesBase <- T.strip . T.pack <$> evalAttr runNixEvalRawInRepo "#pointy.srcFiles"
+    liftIO $ concat <$> mapM (projectEntries ctx (unpack srcFilesBase)) (Map.elems projects)
+  where
+    evalAttr eval attr = withExceptT (("Failed to evaluate " ++ attr ++ ": ") ++) (eval ctx attr)
+
+projectEntries :: ReadRepoContext -> FilePath -> ProjectDef -> IO [FileIndexEntry]
+projectEntries ctx srcFilesBase project = do
+    outPaths <- either outputsUnavailable pure =<< getProjectOutPaths pid (pack (readCommitHash ctx))
+    concat
+        <$> sequence
+            ( [entriesUnder pid sid "output" (unpack outPath) | (sid, outPath) <- Map.toAscList outPaths]
+                ++ [entriesUnder pid sid "source" (srcFilesBase </> show sid) | sid <- stepIds]
+            )
+  where
+    pid = projectDefId project
+    stepIds = Set.toAscList $ Set.fromList $ map (stepDefId . stepRefDef) $ projectDefSteps project
+    outputsUnavailable err = do
+        putStrLn $ "File index skipped the outputs of project " ++ show pid ++ ": " ++ err
+        pure Map.empty
+
+entriesUnder :: Int -> Int -> Text -> FilePath -> IO [FileIndexEntry]
+entriesUnder pid sid entryTarget = go Set.empty []
+  where
+    go branch prefix dir = do
+        canonical <- canonicalizePath dir
+        isDir <- doesDirectoryExist canonical
+        isFile <- doesFileExist canonical
+        names <-
+            if isDir && not (Set.member canonical branch) && "/nix/store/" `isPrefixOf` canonical
+                then sort <$> listDirectory dir
+                else pure []
+        nested <- mapM (\name -> go (Set.insert canonical branch) (name : prefix) (dir </> name)) names
+        pure $ [FileIndexEntry pid sid entryTarget (reverse prefix) | isFile] ++ concat nested

backend/src/Handlers/Store.hs

@@ -4,7 +4,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-name-shadowing #-}
 
-module Handlers.Store (listHandler, downloadHandler, seekHandler, storeFilesHandler, stepListHandler, stepDownloadHandler, stepSeekHandler, stepRawHandler, stepBundleHandler, stepExtrasHandler, DirEntry (..), FileChunk, LineOffset, ByteOffset, fileChunkSize, maxViewableSize, checkViewableAndMime, parseSeekOffset) where
+module Handlers.Store (listHandler, downloadHandler, seekHandler, storeFilesHandler, stepListHandler, stepDownloadHandler, stepSeekHandler, stepRawHandler, stepBundleHandler, stepExtrasHandler, DirEntry (..), FileChunk, LineOffset, ByteOffset, fileChunkSize, maxViewableSize, checkViewableAndMime, parseSeekOffset, resolveCommitHash) where
 
 import ApiTypes (DynamicJson (..))
 

frontend/src/Actions.elm

@@ -344,6 +344,13 @@ loadUserRepoInfo =
     callApi userRepoInfo Api.fetchUserRepoInfo |> Flow.return ()
 
 
+loadFileIndex : Flow Model ()
+loadFileIndex =
+    Flow.try (route << Route.page << Route.project << mCommit << just)
+        (callApi fileIndex << Api.fetchFileIndex)
+        |> Flow.return ()
+
+
 loadStepConfig : Flow Model ()
 loadStepConfig =
     Flow.get
@@ -361,6 +368,7 @@ loadStepConfig =
 
                             Just c ->
                                 Flow.setAll commitHash (ApiData.Success c)
+                                    |> Flow.seq (Flow.async loadFileIndex)
                         )
             )
         |> Flow.return ()
@@ -429,7 +437,7 @@ removeProjectTemplate template =
 
 refetchCommitHash : Flow Model ()
 refetchCommitHash =
-    callApi commitHash Api.fetchCommitHash |> Flow.map (always ())
+    callApi commitHash Api.fetchCommitHash |> Flow.seq (Flow.async loadFileIndex)
 
 
 removeRecord : TableSpec (BaseRecord a) -> Int -> Flow Model ()
@@ -940,6 +948,7 @@ runStep spec id =
                                     Nothing ->
                                         "Step completed"
                                 )
+                                |> Flow.seq loadFileIndex
                             )
                         )
                     |> Flow.seq (callApi void (Api.runStep id mCommit_))
@@ -2188,8 +2197,8 @@ updateSortKeys mProjectId tableSpec records_ =
         |> Flow.return ()
 
 
-onSelectSearch : Maybe Int -> Int -> Flow Model ()
-onSelectSearch mProjectId stepId =
+onSelectSearch : Maybe Int -> Route.Highlight -> Flow Model ()
+onSelectSearch mProjectId highlight =
     Flow.get
         |> Flow.andThen
             (\model ->
@@ -2198,10 +2207,10 @@ onSelectSearch mProjectId stepId =
                         try (route << Route.page << Route.project << mCommit << just) model
 
                     pickedProjectId =
-                        mProjectId |> Maybe.orElse (try (projectsContainingEntity stepId << recordId << just) model)
+                        mProjectId |> Maybe.orElse (try (projectsContainingEntity highlight.id << recordId << just) model)
                 in
                 pickedProjectId
-                    |> Maybe.unwrap (Flow.pure ()) (\pId -> goToRoute (Route.fromPage (Route.Project { projectId = pId, mHighlight = Just { id = stepId, target = Route.Output, path = [], range = Nothing }, mCommit = mCommit_, mCompare = Nothing })))
+                    |> Maybe.unwrap (Flow.pure ()) (\pId -> goToRoute (Route.fromPage (Route.Project { projectId = pId, mHighlight = Just highlight, mCommit = mCommit_, mCompare = Nothing })))
             )
 
 

frontend/src/Api/Api.elm

@@ -12,6 +12,7 @@ module Api.Api exposing
     , fetchDirectoryContents
     , fetchExtras
     , fetchFileContents
+    , fetchFileIndex
     , fetchFileSeek
     , fetchNotices
     , fetchPresets
@@ -43,7 +44,7 @@ import Http
 import Json.Decode
 import Json.Encode
 import Maybe.Extra as Maybe
-import Model.Core exposing (BaseRecord, DirectoryItem, FileChunk, Notice, ProjectRecord, StepRecord)
+import Model.Core exposing (BaseRecord, DirectoryItem, FileChunk, FileIndexEntry, Notice, ProjectRecord, StepRecord)
 import Model.Shadow exposing (Presets, StepConfig, StepType)
 import Model.TableSpec as TableSpec exposing (TableSpec)
 import Url.Builder as UrlBuilder
@@ -406,6 +407,15 @@ fetchUserRepoInfo =
             }
 
 
+fetchFileIndex : Maybe String -> Flow s (Result Http.Error (List FileIndexEntry))
+fetchFileIndex commit =
+    Flow.lift <|
+        Http.get
+            { url = appendCommitQuery "/backend/file-index" commit
+            , expect = Http.expectJson identity (Json.Decode.list Decode.fileIndexEntry)
+            }
+
+
 fetchSrcDirectoryContents : Json.Decode.Decoder ( String, DirectoryItem ) -> Int -> List String -> Flow s (Result Http.Error (Dict String DirectoryItem))
 fetchSrcDirectoryContents itemDecoder id folderPath =
     Flow.lift <|

frontend/src/Api/Decode.elm

@@ -9,6 +9,7 @@ import Json.Decode as Decode exposing (Decoder, maybe)
 import Json.Decode.Pipeline exposing (optional, required)
 import Model.Core as Model exposing (DirectoryItem(..), FileView, ProjectRecord, Status(..), StepRecord, StepStatusEvent(..), TemplateSource(..), initialTable)
 import Model.Shadow exposing (ArgType, Preset, Presets, StepArgType(..), StepArgValue(..), StepConfig, StepConfigEntry, StepType(..), TStringDisplay(..), WithSrcFiles(..))
+import Route exposing (HighlightTarget(..))
 
 
 stepStatusEvent : Decoder StepStatusEvent
@@ -38,6 +39,32 @@ userRepoInfo =
         |> required "branch" Decode.string
 
 
+fileIndexTarget : Decoder HighlightTarget
+fileIndexTarget =
+    Decode.string
+        |> Decode.andThen
+            (\str ->
+                case str of
+                    "output" ->
+                        Decode.succeed Output
+
+                    "source" ->
+                        Decode.succeed Source
+
+                    _ ->
+                        Decode.fail ("Unknown file-index target: " ++ str)
+            )
+
+
+fileIndexEntry : Decoder Model.FileIndexEntry
+fileIndexEntry =
+    Decode.succeed Model.FileIndexEntry
+        |> required "projectId" Decode.int
+        |> required "stepId" Decode.int
+        |> required "target" fileIndexTarget
+        |> required "path" (Decode.list Decode.string)
+
+
 snapshot : Decoder { projectId : Int, commit : String, steps : List { stepId : Int, status : Status } }
 snapshot =
     Decode.succeed (\pid c s -> { projectId = pid, commit = c, steps = s })

frontend/src/Components/Select.elm

@@ -15,6 +15,7 @@ import Json.Decode as Decode
 import Keyboard
 import List.Extra as List
 import Maybe.Extra as Maybe
+import Route
 import Task
 import View.Icons exposing (iconCustom)
 
@@ -32,6 +33,7 @@ type alias Item =
     { id : Maybe Int
     , name : String
     , mProjectId : Maybe Int
+    , mHighlight : Maybe Route.Highlight
     }
 
 

frontend/src/Model/Core.elm

@@ -157,6 +157,14 @@ type alias UserRepoInfo =
     }
 
 
+type alias FileIndexEntry =
+    { projectId : Int
+    , stepId : Int
+    , target : Route.HighlightTarget
+    , path : List String
+    }
+
+
 type alias AgentPreparedApply =
     { targetHead : String
     , agentHead : String
@@ -410,6 +418,7 @@ type Model
         , presets : ApiData Presets
         , commitHash : ApiData String
         , userRepoInfo : ApiData UserRepoInfo
+        , fileIndex : ApiData (List FileIndexEntry)
         , uploadProgress : Dict Int UploadProgress
         , stepLogs : Dict String (ApiData String)
         , notices : Dict String (ApiData (List Notice))
@@ -667,6 +676,11 @@ getUserRepoInfo (Model model) =
     model.userRepoInfo
 
 
+getFileIndex : Model -> ApiData (List FileIndexEntry)
+getFileIndex (Model model) =
+    model.fileIndex
+
+
 getStepLogs : Model -> Dict String (ApiData String)
 getStepLogs (Model model) =
     model.stepLogs
@@ -803,6 +817,7 @@ initialModel key route flags =
         , presets = NotAsked
         , commitHash = NotAsked
         , userRepoInfo = NotAsked
+        , fileIndex = NotAsked
         , stepLogs = Dict.empty
         , notices = Dict.empty
         , uploadProgress = Dict.empty

frontend/src/Model/Lenses.elm

@@ -158,6 +158,11 @@ userRepoInfo =
     lens ".userRepoInfo" Model.getUserRepoInfo (\(Model m) userRepoInfo_ -> Model { m | userRepoInfo = userRepoInfo_ })
 
 
+fileIndex : Lens ls Model (ApiData (List Model.FileIndexEntry)) x y
+fileIndex =
+    lens ".fileIndex" Model.getFileIndex (\(Model m) fileIndex_ -> Model { m | fileIndex = fileIndex_ })
+
+
 stepLogs : Lens ls Model (Dict String (ApiData String)) x y
 stepLogs =
     lens ".stepLogs" Model.getStepLogs (\(Model m) stepLogs_ -> Model { m | stepLogs = stepLogs_ })