From 3a792addcdeffa955f6516aada791228fb3081cd Mon Sep 17 00:00:00 2001 From: Thomas Honeyman Date: Sat, 14 Nov 2026 18:13:13 +0000 Subject: [PATCH] Remove the /search type-search endpoint No client has ever called /search, and it is undocumented. It has answered every query with "Cannot parse type" since the 0.13 update: it lexed queries with lexTopLevel, whose layout tokens parseTypeP rejects. Queries with type variables would also crash the search on current compilers, which need kinds on its skolems and unknowns. Remove the route and its helpers, along with the compiler Environment that only the search used. --- CHANGELOG.md | 1 + server/Main.hs | 79 ++++---------------------------------------------- 2 files changed, 7 insertions(+), 73 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2d48b83..cbd937d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ Notable changes to this project are documented in this file. The format is based ## [Unreleased] Breaking changes: +- Remove the undocumented `/search` type-search endpoint, which no client used and which has answered every query with "Cannot parse type" since the update to PureScript 0.13 (#326 by @thomashoneyman) New features: diff --git a/server/Main.hs b/server/Main.hs index 533af7f..333fa16 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -1,24 +1,19 @@ -{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} module Main (main) where import Control.Monad (foldM) -import qualified Control.Monad.State as State import Control.Monad.Trans (lift) import Control.Monad.Trans.Except (ExceptT(..), runExceptT) import Control.Monad.Writer.Strict (runWriterT) import qualified Data.Aeson as A import Data.Aeson ((.=)) -import Data.Bifunctor (second, bimap) +import Data.Bifunctor (second) import qualified Data.ByteString.Lazy as BL import Data.Default (def) -import Data.Function (on) import qualified Data.IORef as IORef -import Data.List (nubBy) import qualified Data.List.NonEmpty as NE import qualified Data.Map as M import qualified Data.Set as Set @@ -29,7 +24,6 @@ import Data.Time.Clock (UTCTime) import GHC.Generics (Generic) import qualified Language.PureScript as P import qualified Language.PureScript.CST as CST -import qualified Language.PureScript.CST.Monad as CSTM import qualified Language.PureScript.CodeGen.JS as J import qualified Language.PureScript.CodeGen.JS.Printer as P import qualified Language.PureScript.CoreFn as CF @@ -39,7 +33,6 @@ import qualified Language.PureScript.Interactive as I import qualified Language.PureScript.Make as Make import qualified Language.PureScript.Make.Cache as Cache import qualified Language.PureScript.Names as N -import qualified Language.PureScript.TypeChecker.TypeSearch as TS import qualified Network.Wai.Handler.Warp as Warp import System.Environment (getArgs) import System.Exit (exitFailure) @@ -116,8 +109,8 @@ buildMakeActions codegenRef = outputPrimDocs :: Make.Make () outputPrimDocs = pure () -server :: [N.ModuleName] -> [P.ExternsFile] -> P.Env -> P.Environment -> Int -> IO () -server allModuleNames externs initNamesEnv initEnv port = do +server :: [N.ModuleName] -> [P.ExternsFile] -> P.Env -> Int -> IO () +server allModuleNames externs initNamesEnv port = do codegenRef <- IORef.newIORef Nothing let makeActions = buildMakeActions codegenRef let modNames = Set.fromList allModuleNames @@ -166,26 +159,6 @@ server allModuleNames externs initNamesEnv initEnv port = do Right (warnings, comp) -> Scotty.json $ A.object [ "js" .= comp, "warnings" .= warnings ] - get "/search" $ do - query <- queryParam "q" - Scotty.setHeader "Access-Control-Allow-Origin" "*" - Scotty.setHeader "Content-Type" "application/json" - case tryParseType query of - Nothing -> Scotty.json $ A.object [ "error" .= ("Cannot parse type" :: Text) ] - Just ty -> do - let elabs = lookupAllConstructors initEnv ty - search = fst . TS.typeSearch (Just []) initEnv (P.emptyCheckState initEnv) - results = nubBy ((==) `on` fst) $ do - elab <- elabs - let mkSkolemType nm s = P.Skolem P.NullSourceAnn nm Nothing s (P.SkolemScope 0) - strictMatches = search (replaceTypeVariablesAndDesugar mkSkolemType elab) - flexMatches = search (replaceTypeVariablesAndDesugar (const (P.TUnknown P.NullSourceAnn)) elab) - take 50 (strictMatches ++ flexMatches) - Scotty.json $ A.object [ "results" .= [ P.showQualified id k - | (k, _) <- take 50 results - ] - ] - getOpts :: Int -> Scotty.Options getOpts port = def { settings = @@ -194,46 +167,6 @@ getOpts port = def $ Warp.defaultSettings } -lookupAllConstructors :: P.Environment -> P.SourceType -> [P.SourceType] -lookupAllConstructors env = P.everywhereOnTypesM $ \case - P.TypeConstructor ann (P.Qualified (N.BySourcePos _) tyCon) -> P.TypeConstructor ann <$> lookupConstructor env tyCon - other -> pure other - where - lookupConstructor :: P.Environment -> P.ProperName 'P.TypeName -> [P.Qualified (P.ProperName 'P.TypeName)] - lookupConstructor env' nm = - [ q - | (q@(P.Qualified (N.ByModuleName _) thisNm), _) <- M.toList (P.types env') - , thisNm == nm - ] - --- | (Consistently) replace unqualified type constructors and type variables with unknowns. --- --- Also remove the @ParensInType@ Constructor (we need to deal with type operators later at some point). -replaceTypeVariablesAndDesugar :: (Text -> Int -> P.SourceType) -> P.SourceType -> P.SourceType -replaceTypeVariablesAndDesugar f ty = State.evalState (P.everywhereOnTypesM go ty) (0, M.empty) where - go = \case - P.ParensInType _ inner -> pure inner - P.TypeVar _ s -> do - (n, m) <- State.get - case M.lookup s m of - Nothing -> do - let unknown = f s n - State.put (n + 1, M.insert s unknown m) - pure unknown - Just unknown -> pure unknown - other -> pure other - -tryParseType :: Text -> Maybe P.SourceType -tryParseType = hush . fmap (CST.convertType "") . runParser CST.parseTypeP - where - hush = either (const Nothing) Just - - runParser :: CST.Parser a -> Text -> Either String a - runParser p = - bimap (CST.prettyPrintError . NE.head) snd - . CST.runTokenParser (p <* CSTM.token CST.TokEof) - . CST.lexTopLevel - main :: IO () main = do -- Stop mangled "Compiling ModuleName" text @@ -251,11 +184,11 @@ main = do inputFiles <- concat <$> traverse glob inputGlobs e <- runExceptT $ do modules <- ExceptT $ I.loadAllModules inputFiles - (exts, env) <- ExceptT . I.runMake . I.make $ map (second CST.pureResult) modules + (exts, _) <- ExceptT . I.runMake . I.make $ map (second CST.pureResult) modules namesEnv <- fmap fst . runWriterT $ foldM P.externsEnv P.primEnv exts let allModuleNames = fmap (P.getModuleName . snd) modules - pure (allModuleNames, exts, namesEnv, env) + pure (allModuleNames, exts, namesEnv) case e of Left err -> print err >> exitFailure - Right (allModuleNames, exts, namesEnv, env) -> server allModuleNames exts namesEnv env port + Right (allModuleNames, exts, namesEnv) -> server allModuleNames exts namesEnv port