diff --git a/backend/app/Main.hs b/backend/app/Main.hs index b9f4328..532fdc0 100644 --- a/backend/app/Main.hs +++ b/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 diff --git a/backend/backend.cabal b/backend/backend.cabal index 11776f2..60c69d8 100644 --- a/backend/backend.cabal +++ b/backend/backend.cabal @@ -29,6 +29,7 @@ library Handlers.CommitHash Handlers.ClusterStream Handlers.Download + Handlers.FileIndex Handlers.Presets Handlers.ProjectEntities Handlers.Projects diff --git a/backend/src/Api.hs b/backend/src/Api.hs index a3cabc4..1c1867b 100644 --- a/backend/src/Api.hs +++ b/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 diff --git a/backend/src/Docs/OpenApi.hs b/backend/src/Docs/OpenApi.hs index 659bb0a..da2a68d 100644 --- a/backend/src/Docs/OpenApi.hs +++ b/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 diff --git a/backend/src/Handlers/FileIndex.hs b/backend/src/Handlers/FileIndex.hs new file mode 100644 index 0000000..37b10c4 --- /dev/null +++ b/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 diff --git a/backend/src/Handlers/Store.hs b/backend/src/Handlers/Store.hs index 622f813..1029a48 100644 --- a/backend/src/Handlers/Store.hs +++ b/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 (..)) diff --git a/frontend/src/Actions.elm b/frontend/src/Actions.elm index 6c99366..4706d06 100644 --- a/frontend/src/Actions.elm +++ b/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 }))) ) diff --git a/frontend/src/Api/Api.elm b/frontend/src/Api/Api.elm index f8de3bf..df9e76a 100644 --- a/frontend/src/Api/Api.elm +++ b/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 <| diff --git a/frontend/src/Api/Decode.elm b/frontend/src/Api/Decode.elm index e6f17f1..bc88deb 100644 --- a/frontend/src/Api/Decode.elm +++ b/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 }) diff --git a/frontend/src/Components/Select.elm b/frontend/src/Components/Select.elm index f294de0..7a652f2 100644 --- a/frontend/src/Components/Select.elm +++ b/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 } diff --git a/frontend/src/Model/Core.elm b/frontend/src/Model/Core.elm index 4e16ac3..78e6f2f 100644 --- a/frontend/src/Model/Core.elm +++ b/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 diff --git a/frontend/src/Model/Lenses.elm b/frontend/src/Model/Lenses.elm index 9312f69..3fb8e24 100644 --- a/frontend/src/Model/Lenses.elm +++ b/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_ }) diff --git a/frontend/src/Model/Lib.elm b/frontend/src/Model/Lib.elm index 5dad7bc..adb44d3 100644 --- a/frontend/src/Model/Lib.elm +++ b/frontend/src/Model/Lib.elm @@ -1,11 +1,13 @@ module Model.Lib exposing (..) -import Accessors exposing (all, each, has, over, values) +import Accessors exposing (all, each, get, has, over, values) import Api.ApiData as ApiData exposing (success) import Components.Select exposing (Item) import Dict exposing (Dict) -import Model.Core exposing (Model, ProjectRecord, getSortKey) -import Model.Lenses exposing (commitHash, presets, projectStepRecords, projects, records, stepConfig, tables) +import Dict.Extra +import Model.Core exposing (FileIndexEntry, Model, ProjectRecord, StepRecord, getSortKey) +import Model.Lenses exposing (commitHash, fileIndex, presets, projectStepRecords, projects, records, searchBox, stepConfig, tables) +import Route exposing (HighlightTarget(..)) sortProjects : Dict String ProjectRecord -> List ProjectRecord @@ -22,20 +24,46 @@ sortProjects = getSearchItems : Model -> List Item getSearchItems model = + let + search = + get searchBox model + + filesByStep = + if not search.active || String.isEmpty (String.trim search.input) then + Dict.empty + + else + all (fileIndex << success << each) model + |> Dict.Extra.groupBy (\entry -> ( entry.projectId, entry.stepId )) + + stepFiles project step = + Maybe.withDefault [] (Dict.get ( Maybe.withDefault 0 project.id, Maybe.withDefault 0 step.id ) filesByStep) + in all (projects << records << success << each) model |> List.concatMap (\project -> all projectStepRecords project - |> List.map + |> List.concatMap (\step -> { id = Just (step.id |> Maybe.withDefault 0) , name = "(" ++ step.type_ ++ ") " ++ step.name ++ " — " ++ project.name , mProjectId = project.id + , mHighlight = Just { id = step.id |> Maybe.withDefault 0, target = Output, path = [], range = Nothing } } + :: List.map (fileSearchItem project step) (stepFiles project step) ) ) +fileSearchItem : ProjectRecord -> StepRecord -> FileIndexEntry -> Item +fileSearchItem project step entry = + { id = Just entry.stepId + , name = String.join "/" entry.path ++ " — " ++ step.name ++ " — " ++ project.name + , mProjectId = Just entry.projectId + , mHighlight = Just { id = entry.stepId, target = entry.target, path = entry.path, range = Nothing } + } + + isWorkspaceReloading : Model -> Bool isWorkspaceReloading model = has (projects << records << ApiData.reloading) model diff --git a/frontend/src/View/Lib.elm b/frontend/src/View/Lib.elm index 1658991..910abb0 100644 --- a/frontend/src/View/Lib.elm +++ b/frontend/src/View/Lib.elm @@ -40,7 +40,7 @@ viewSearchBox model = , hasChanged = False , label = "" , mHint = Nothing - , placeholder = "Search for steps" + , placeholder = "Search for steps and files" , inputIcon = Just "search" , toInputItemName = .name , toInputItemTooltip = \_ -> [] @@ -55,7 +55,7 @@ viewSearchBox model = \item -> Maybe.unwrap (Flow.pure ()) (Actions.onSelectSearch item.mProjectId) - item.id + item.mHighlight , alignRight = True , inputItemStyle = \_ -> [] } diff --git a/frontend/src/View/Table.elm b/frontend/src/View/Table.elm index 2914f9f..1a26be8 100644 --- a/frontend/src/View/Table.elm +++ b/frontend/src/View/Table.elm @@ -678,7 +678,7 @@ viewAddOrEditRecordForm model spec table record = try currentProjectId model availableItems = - List.map (\{ id, name } -> { id = id, name = name, mProjectId = Nothing }) + List.map (\{ id, name } -> { id = id, name = name, mProjectId = Nothing, mHighlight = Nothing }) (all (allEntities (where_ (\{ id } -> id /= mProjectId) << tables << key (TableSpec.getName spec) << just)) model |> List.filter (\r -> r.id |> Maybe.unwrap True (\id -> not (List.member id (ApiData.withDefault [] table.records |> List.filterMap .id)))) @@ -810,6 +810,7 @@ viewProjectExtraFormFields model readOnly = { id = Dict.get name_ templateIdMap , name = name_ , mProjectId = Nothing + , mHighlight = Nothing } templateLabel name_ = @@ -838,6 +839,7 @@ viewProjectExtraFormFields model readOnly = { id = Dict.get name_ presetIdMap , name = name_ , mProjectId = Nothing + , mHighlight = Nothing } presetMenuLabel name_ = @@ -1085,6 +1087,7 @@ viewStepExtraFormFields model readOnly tableId stepDef = else step.name ++ " (not in project)" , mProjectId = Nothing + , mHighlight = Nothing } ) @@ -1093,7 +1096,7 @@ viewStepExtraFormFields model readOnly tableId stepDef = availableItems = allSteps mAllowedStepTypes - |> List.filterMap (\step -> step.id |> Maybe.map (\id -> { id = Just id, name = step.name, mProjectId = Nothing })) + |> List.filterMap (\step -> step.id |> Maybe.map (\id -> { id = Just id, name = step.name, mProjectId = Nothing, mHighlight = Nothing })) |> List.filter (\item -> not (List.member item.id selectedIds)) toTooltip =