From 9af44292e484e77ba13cdc06badd5522111ae559 Mon Sep 17 00:00:00 2001 From: Fyodor Soikin Date: Sun, 9 Feb 2025 04:59:56 -0500 Subject: [PATCH] Restore type-directed search (#1325) --- CHANGELOG.md | 1 + core/src/Log.purs | 2 + .../common/src/Docs/Search/TypeIndex.purs | 34 +++-- .../index/src/Docs/Search/IndexBuilder.purs | 141 ++++++++---------- src/Spago/Command/Docs.purs | 20 ++- src/Spago/Purs.purs | 19 ++- 6 files changed, 114 insertions(+), 103 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 34d0b7295..189c003e2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -47,6 +47,7 @@ Other improvements: their specified dependency ranges. - `spago publish` no longer tries to validate all workspace dependencies, but only the (transitive) dependencies of the project being published. +- Restored broken search-directed search in generated docs. ## [0.21.0] - 2023-05-04 diff --git a/core/src/Log.purs b/core/src/Log.purs index ea7eb4694..7bb765838 100644 --- a/core/src/Log.purs +++ b/core/src/Log.purs @@ -77,6 +77,8 @@ data LogVerbosity | LogNormal | LogVerbose +derive instance Eq LogVerbosity + -- | LogVeryVerbose -- TODO:we'll need to add timestamps, and locations, see https://stackoverflow.com/questions/45395369/ data LogLevel diff --git a/docs-search/common/src/Docs/Search/TypeIndex.purs b/docs-search/common/src/Docs/Search/TypeIndex.purs index aac6210f7..e8f6f71ea 100644 --- a/docs-search/common/src/Docs/Search/TypeIndex.purs +++ b/docs-search/common/src/Docs/Search/TypeIndex.purs @@ -7,14 +7,16 @@ module Docs.Search.TypeIndex import Prelude +import Codec.JSON.DecodeError as DecodeError import Control.Promise (Promise, toAffE) import Data.Array as Array +import Data.Bifunctor (lmap) import Data.Codec.JSON as CJ -import Data.Either (hush) +import Data.Either (Either(..)) import Data.Foldable (fold, foldr) import Data.Map (Map) import Data.Map as Map -import Data.Maybe (Maybe(..), fromMaybe') +import Data.Maybe (Maybe(..)) import Data.Newtype (class Newtype, over) import Data.Set (Set) import Docs.Search.Config as Config @@ -27,6 +29,8 @@ import Docs.Search.TypeQuery (TypeQuery) import Docs.Search.TypeShape (shapeOfType, shapeOfTypeQuery, stringifyShape) import Effect (Effect) import Effect.Aff (Aff, try) +import Effect.Aff as Error +import Effect.Class.Console as Console import JSON (JSON) import Language.PureScript.Docs.Types (DocModule(..)) import Registry.PackageName (PackageName) @@ -80,15 +84,22 @@ lookup -> Aff { index :: TypeIndex, results :: Array SearchResult } lookup key index@(TypeIndex map) = case Map.lookup key map of - Just results -> pure { index, results: fold results } + Just results -> + pure { index, results: fold results } Nothing -> do - eiJson <- try (toAffE (lookup_ key $ Config.mkShapeScriptPath key)) - pure $ fromMaybe' - (\_ -> { index: insert key Nothing index, results: [] }) - do - json <- hush eiJson - results <- hush (CJ.decode (CJ.array SearchResult.searchResultCodec) json) + eitherJson <- try $ toAffE $ lookup_ key (Config.mkShapeScriptPath key) + + let + eitherResults = do + json <- eitherJson # lmap Error.message + CJ.decode (CJ.array SearchResult.searchResultCodec) json # lmap DecodeError.print + + case eitherResults of + Right results -> pure { index: insert key (Just results) index, results } + Left err -> do + Console.error $ "Error reading type index: " <> err + pure { index: insert key Nothing index, results: [] } where insert @@ -102,9 +113,8 @@ query :: TypeIndex -> TypeQuery -> Aff { index :: TypeIndex, results :: Array SearchResult } -query typeIndex typeQuery = do - res <- lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex - pure $ res { results = res.results } +query typeIndex typeQuery = + lookup (stringifyShape $ shapeOfTypeQuery typeQuery) typeIndex foreign import lookup_ :: String diff --git a/docs-search/index/src/Docs/Search/IndexBuilder.purs b/docs-search/index/src/Docs/Search/IndexBuilder.purs index d15f834ec..6eca91f15 100644 --- a/docs-search/index/src/Docs/Search/IndexBuilder.purs +++ b/docs-search/index/src/Docs/Search/IndexBuilder.purs @@ -51,7 +51,6 @@ import Docs.Search.Types (PartId) import Effect (Effect) import Effect.Aff (Aff, parallel, sequential) import Effect.Class (liftEffect) -import Effect.Console (log) import JSON (JSON) import JSON as JSON import Node.Encoding (Encoding(UTF8)) @@ -59,7 +58,6 @@ import Node.FS.Aff (mkdir, readFile, readTextFile, readdir, stat, writeFile, wri import Node.FS.Stats (isDirectory, isFile) import Node.FS.Sync (exists) import Node.Path as Path -import Node.Process as Process import Registry.Manifest (Manifest(..)) import Registry.Manifest as Manifest import Registry.PackageName (PackageName) @@ -72,15 +70,16 @@ type Config = , generatedDocs :: String , workspacePackages :: Set PackageName , moduleGraph :: Graph.ModuleGraphWithPackage + , log :: String -> Aff Unit + , die :: String -> Aff Unit } run :: Config -> Aff Unit -run cfg = do +run cfg@{ log } = do checkDirectories cfg - liftEffect do - log "Building the search index..." + log "Building the search index..." docsJsons /\ packageMetas <- sequential $ Tuple @@ -91,13 +90,12 @@ run cfg = do countOfPackages = Array.length packageMetas countOfModules = Array.length docsJsons - liftEffect do - log $ - "Indexing " - <> show countOfModules - <> " modules from " - <> show countOfPackages - <> " packages..." + log $ + "Indexing " + <> show countOfModules + <> " modules from " + <> show countOfPackages + <> " packages..." let scores = mkScores packageMetas @@ -108,32 +106,28 @@ run cfg = do createDirectories cfg - void $ sequential do - ignore <$> parallel (writeIndex cfg index) - <*> parallel (writeTypeIndex typeIndex) - <*> parallel (writePackageInfo packageInfo) - <*> parallel (writeModuleIndex moduleIndex) - <*> parallel (patchDocs cfg) - <*> parallel (copyAppFile cfg) + sequential $ + parallel (writeIndex cfg index) + *> parallel (writeTypeIndex typeIndex) + *> parallel (writePackageInfo packageInfo) + *> parallel (writeModuleIndex moduleIndex) + *> parallel (patchDocs cfg) + *> parallel (copyAppFile cfg) let countOfDefinitions = Trie.size $ unwrap index countOfTypeDefinitions = sum $ fromMaybe 0 <$> map Array.length <$> Map.values (unwrap typeIndex) - liftEffect do - log $ - "Added " - <> show countOfDefinitions - <> " definitions and " - <> show countOfTypeDefinitions - <> " type definitions from " - <> show countOfPackages - <> - " packages to the search index." - - where - ignore _ _ _ _ _ _ _ = unit + log $ + "Added " + <> show countOfDefinitions + <> " definitions and " + <> show countOfTypeDefinitions + <> " type definitions from " + <> show countOfPackages + <> + " packages to the search index." -- | Exit early if something is missing. checkDirectories :: Config -> Aff Unit @@ -147,23 +141,20 @@ checkDirectories cfg = do for_ dirs \dir -> do whenM (not <$> directoryExists dir) $ - liftEffect do - logAndExit "Build the documentation first!" + cfg.die "Build the documentation first!" -- | Read and decode given `docs.json` files. decodeDocsJsons - :: forall rest - . { docsFiles :: Array String | rest } + :: ∀ rest + . { docsFiles :: Array String, log :: String -> Aff Unit, die :: String -> Aff Unit | rest } -> Aff (Array DocModule) -decodeDocsJsons cfg@{ docsFiles } = do +decodeDocsJsons cfg@{ docsFiles, log } = do paths <- getPathsByGlobs docsFiles when (Array.null paths) do - liftEffect do - logAndExit $ - "The following globs do not match any files: " <> showGlobs cfg.docsFiles <> - ".\nBuild the documentation first!" + cfg.die $ + "The following globs do not match any files: " <> showGlobs cfg.docsFiles <> ".\nBuild the documentation first!" docsJsons <- Array.catMaybes <$> for paths \jsonFile -> do doesExist <- fileExists jsonFile @@ -179,38 +170,36 @@ decodeDocsJsons cfg@{ docsFiles } = do case eiResult of Left error -> do - liftEffect $ log $ - "\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> error + log $ "\"docs.json\" decoding failed failed for " <> jsonFile <> ": " <> error pure Nothing Right result -> pure $ Just result else do - liftEffect $ do - log $ - "File does not exist: " <> jsonFile + log $ "File does not exist: " <> jsonFile pure Nothing when (Array.null docsJsons) do - liftEffect $ logAndExit $ + cfg.die $ "Couldn't decode any of the files matched by the following globs: " <> showGlobs cfg.docsFiles pure docsJsons -decodePursJsons :: forall rest. { pursJsonFiles :: Array String | rest } -> Aff (Array Manifest) -decodePursJsons { pursJsonFiles } = do +decodePursJsons + :: ∀ rest + . { pursJsonFiles :: Array String, log :: String -> Aff Unit, die :: String -> Aff Unit | rest } + -> Aff (Array Manifest) +decodePursJsons cfg@{ pursJsonFiles } = do paths <- getPathsByGlobs pursJsonFiles when (Array.null paths) do - liftEffect do - logAndExit $ - "The following globs do not match any files: " <> showGlobs pursJsonFiles <> - ".\nAre you in a project directory?" - + cfg.die $ + "The following globs do not match any files: " <> showGlobs pursJsonFiles <> + ".\nAre you in a project directory?" Array.nubBy compareNames <$> Array.catMaybes <$> for paths \jsonFileName -> - join <$> withExisting jsonFileName + join <$> withExisting cfg jsonFileName \contents -> either (logError jsonFileName) (pure <<< Just) ( JSON.parse contents >>= @@ -224,8 +213,7 @@ decodePursJsons { pursJsonFiles } = do (Manifest { name: name2 }) = compare name1 name2 logError fileName error = do - liftEffect $ log $ - "\"purs.json\" decoding failed for " <> fileName <> ": " <> error + cfg.log $ "\"purs.json\" decoding failed for " <> fileName <> ": " <> error pure Nothing -- | Write type index parts to files. @@ -233,7 +221,7 @@ writeTypeIndex :: TypeIndex -> Aff Unit writeTypeIndex typeIndex = for_ entries \(Tuple typeShape results) -> do writeTextFile UTF8 (unwrap Config.typeIndexDirectory <> "/" <> typeShape <> ".js") - (mkHeader typeShape <> JSON.print (CJ.encode codec results)) + (mkHeader typeShape <> JSON.print (CJ.encode codec $ fromMaybe [] results)) where mkHeader typeShape = "// This file was generated by docs-search\n" @@ -241,7 +229,7 @@ writeTypeIndex typeIndex = <> typeShape <> "\"] = " - codec = CJ.Common.maybe $ CJ.array SearchResult.searchResultCodec + codec = CJ.array SearchResult.searchResultCodec entries :: Array _ entries = Map.toUnfoldableUnordered (unwrap typeIndex) @@ -350,18 +338,18 @@ patchDocs cfg = do -- | Create directories for two indices, or fail with a message -- | in case the docs were not generated. createDirectories :: Config -> Aff Unit -createDirectories { generatedDocs } = do +createDirectories { generatedDocs, die } = do let htmlDocs = Path.concat [ generatedDocs, "html" ] indexDir = Path.concat [ generatedDocs, "html", "index" ] declIndexDir = Path.concat [ generatedDocs, "html", "index", "declarations" ] typeIndexDir = Path.concat [ generatedDocs, "html", "index", "types" ] - whenM (not <$> directoryExists generatedDocs) $ liftEffect do - logAndExit "Generate the documentation first!" + whenM (not <$> directoryExists generatedDocs) $ + die "Generate the documentation first!" - whenM (not <$> directoryExists htmlDocs) $ liftEffect do - logAndExit "Generate the documentation first!" + whenM (not <$> directoryExists htmlDocs) $ + die "Generate the documentation first!" whenM (not <$> directoryExists indexDir) do mkdir indexDir @@ -375,13 +363,13 @@ createDirectories { generatedDocs } = do -- | Copy the client-side application, responsible for handling user input and rendering -- | the results, to the destination path. copyAppFile :: Config -> Aff Unit -copyAppFile { generatedDocs } = do +copyAppFile { generatedDocs, die } = do appFile <- liftEffect getDocsSearchAppPath - whenM (not <$> fileExists appFile) do - liftEffect do - logAndExit $ - "Client-side app was not found at " <> appFile <> ".\n" <> - "Check your installation." + unlessM (fileExists appFile) + $ die + $ + "Client-side app was not found at " <> appFile <> ".\n" <> + "Check your installation." buffer <- readFile appFile writeFile (Path.concat [ generatedDocs, "html", "docs-search-app.js" ]) buffer @@ -399,8 +387,8 @@ fileExists path = do false -> pure false true -> isFile <$> stat path -withExisting :: forall a. String -> (String -> Aff a) -> Aff (Maybe a) -withExisting file f = do +withExisting :: ∀ a r. { log :: String -> Aff Unit | r } -> String -> (String -> Aff a) -> Aff (Maybe a) +withExisting cfg file f = do doesExist <- fileExists file if doesExist then do @@ -408,16 +396,9 @@ withExisting file f = do res <- f contents pure $ Just res else do - liftEffect $ do - log $ - "File does not exist: " <> file + cfg.log $ "File does not exist: " <> file pure Nothing -logAndExit :: forall a. String -> Effect a -logAndExit message = do - log message - Process.exit' 1 - showGlobs :: Array String -> String showGlobs = Array.intercalate ", " diff --git a/src/Spago/Command/Docs.purs b/src/Spago/Command/Docs.purs index f795e8335..13fc1d381 100644 --- a/src/Spago/Command/Docs.purs +++ b/src/Spago/Command/Docs.purs @@ -5,6 +5,7 @@ module Spago.Command.Docs import Spago.Prelude +import Control.Monad.Reader (runReaderT) import Control.Promise (Promise) import Control.Promise as Promise import Data.Set as Set @@ -17,6 +18,7 @@ import Spago.Command.Fetch as Fetch import Spago.Command.Graph as Graph import Spago.Config (Workspace) import Spago.Config as Config +import Spago.Log (LogVerbosity(..)) import Spago.Purs (Purs, DocsFormat(..)) import Spago.Purs as Purs @@ -36,7 +38,8 @@ run :: ∀ a. Spago (DocsEnv a) Unit run = do logDebug "Running `spago docs`" logInfo "Generating documentation for the project. This might take a while..." - { rootPath, workspace, dependencies, docsFormat, depsOnly, open } <- ask + env@{ rootPath, workspace, dependencies, docsFormat, depsOnly, open } <- ask + let globs = Build.getBuildGlobs { rootPath @@ -46,10 +49,15 @@ run = do , depsOnly } - result <- Purs.docs rootPath globs docsFormat - case result of - Left r -> die r.message - _ -> pure unit + Purs.docs + { root: rootPath + , globs + , format: docsFormat + , quiet: env.logOptions.verbosity == LogQuiet + } + <#> lmap _.message + >>= rightOrDie + # void when (docsFormat == Html) $ do { moduleGraph } <- Graph.graphModules' @@ -59,6 +67,8 @@ run = do , generatedDocs: "./generated-docs/" , workspacePackages: Set.fromFoldable $ map _.package.name $ Config.getWorkspacePackages workspace.packageSet , moduleGraph + , log: \x -> runReaderT (logInfo x) env + , die: \x -> runReaderT (die x) env } currentDir <- liftEffect Process.cwd diff --git a/src/Spago/Purs.purs b/src/Spago/Purs.purs index 50fc4c3d1..0cc949db4 100644 --- a/src/Spago/Purs.purs +++ b/src/Spago/Purs.purs @@ -110,14 +110,21 @@ printDocsFormat = case _ of Ctags -> "ctags" Etags -> "etags" -docs :: ∀ a. RootPath -> Set LocalPath -> DocsFormat -> Spago (PursEnv a) (Either ExecaResult ExecaResult) -docs cwd globs format = do +docs + :: ∀ a + . { root :: RootPath + , globs :: Set LocalPath + , format :: DocsFormat + , quiet :: Boolean + } + -> Spago (PursEnv a) (Either ExecaResult ExecaResult) +docs cfg = do { purs } <- ask - let args = [ "docs", "--format", printDocsFormat format ] <> globsToArgs cwd globs + let args = [ "docs", "--format", printDocsFormat cfg.format ] <> globsToArgs cfg.root cfg.globs Cmd.exec purs.cmd args $ Cmd.defaultExecOptions - { cwd = Just $ Path.toGlobal cwd - , pipeStdout = true - , pipeStderr = true + { cwd = Just $ Path.toGlobal cfg.root + , pipeStdout = not cfg.quiet + , pipeStderr = not cfg.quiet , pipeStdin = Cmd.StdinPipeParent }