From e5a531da616641bc6955d12ed61dc56d5a4b3d1c Mon Sep 17 00:00:00 2001 From: Krasimir Angelov Date: Sat, 30 Aug 2025 20:09:13 +0200 Subject: [PATCH] testing repl not needed anymore --- src/compiler/api/GF/Compile/Repl.hs | 313 ---------------------------- src/compiler/gf-repl.hs | 12 -- src/compiler/gf.cabal | 7 - 3 files changed, 332 deletions(-) delete mode 100644 src/compiler/api/GF/Compile/Repl.hs delete mode 100644 src/compiler/gf-repl.hs diff --git a/src/compiler/api/GF/Compile/Repl.hs b/src/compiler/api/GF/Compile/Repl.hs deleted file mode 100644 index 7c952cd9e..000000000 --- a/src/compiler/api/GF/Compile/Repl.hs +++ /dev/null @@ -1,313 +0,0 @@ -{-# LANGUAGE LambdaCase, TupleSections, NamedFieldPuns #-} - -module GF.Compile.Repl (ReplOpts(..), defaultReplOpts, replOptDescrs, getReplOpts, runRepl, runRepl') where - -import Control.Monad (join, when, unless, forM_, foldM) -import Control.Monad.IO.Class (MonadIO) -import qualified Data.ByteString.Char8 as BS -import Data.Char (isSpace) -import Data.Function ((&)) -import Data.Functor ((<&>)) -import Data.List (find) -import qualified Data.Map as Map -import Data.Maybe (fromMaybe) -import Text.Read (readMaybe) - -import System.Console.GetOpt (ArgOrder(RequireOrder), OptDescr(..), ArgDescr(..), getOpt, usageInfo) -import System.Console.Haskeline (InputT, Settings(..), noCompletion, runInputT, getInputLine, outputStrLn) -import System.Directory (getAppUserDataDirectory) - -import GF.Compile (batchCompile) -import GF.Compile.Compute.Concrete2 - ( Choice(..) - , ChoiceMap - , Globals(Gl) - , OptionInfo(..) - , stdPredef - , unit - , eval - , cleanOptions - , runEvalMWithOpts - , value2termM - , ppValue - ) -import GF.Compile.Rename (renameSourceTerm) -import GF.Compile.TypeCheck.Concrete (inferLType) -import GF.Data.ErrM (Err(..)) -import GF.Data.Utilities (maybeAt, orLeft) -import GF.Grammar.Grammar - ( Grammar - , mGrammar - , Info - , Module - , ModuleName - , ModuleInfo(..) - , ModuleType(MTResource) - , ModuleStatus(MSComplete) - , OpenSpec(OSimple) - , Location (NoLoc) - , Term(Typed) - , prependModule - ) -import GF.Grammar.Lexer (Posn(..), Lang(..), runLangP) -import GF.Grammar.Parser (pTerm) -import GF.Grammar.Printer (TermPrintQual(Unqualified), ppTerm) -import GF.Infra.CheckM (Check, runCheck) -import GF.Infra.Ident (moduleNameS) -import GF.Infra.Option (noOptions) -import GF.Infra.UseIO (justModuleName) -import GF.Text.Pretty (render) -import Debug.Trace - -data ReplOpts = ReplOpts - { lang :: Lang - , noPrelude :: Bool - , inputFiles :: [String] - , evalToFlat :: Bool - } - -defaultReplOpts :: ReplOpts -defaultReplOpts = ReplOpts - { lang = GF - , noPrelude = False - , inputFiles = [] - , evalToFlat = True - } - -type Errs a = Either [String] a -type ReplOptsOp = ReplOpts -> Errs ReplOpts - -replOptDescrs :: [OptDescr ReplOptsOp] -replOptDescrs = - [ Option ['h'] ["help"] (NoArg $ \o -> Left [usageInfo "gfci" replOptDescrs]) "Display help." - , Option [] ["no-prelude"] (flag $ \o -> o { noPrelude = True }) "Don't load the prelude." - , Option [] ["lang"] (ReqArg (\s o -> case s of - "gf" -> Right (o { lang = GF }) - "bnfc" -> Right (o { lang = BNFC }) - "nlg" -> Right (o { lang = NLG }) - _ -> Left ["Unknown language variant: " ++ s]) - "{gf,bnfc,nlg}") - "Set the active language variant." - , Option [] ["no-flat"] (flag $ \o -> o { evalToFlat = False }) "Do not evaluate to flat form." - ] - where - flag f = NoArg $ \o -> pure (f o) - -getReplOpts :: [String] -> Errs ReplOpts -getReplOpts args = case errs of - [] -> foldM (&) defaultReplOpts flags <&> \o -> o { inputFiles = inputFiles } - _ -> Left errs - where - (flags, inputFiles, errs) = getOpt RequireOrder replOptDescrs args - -execCheck :: MonadIO m => Check a -> (a -> InputT m b) -> InputT m (Maybe b) -execCheck c k = case runCheck c of - Ok (a, warn) -> do - unless (null warn) $ outputStrLn warn - Just <$> k a - Bad err -> do - outputStrLn err - return Nothing - -replModNameStr :: String -replModNameStr = "" - -replModName :: ModuleName -replModName = moduleNameS replModNameStr - -parseThen :: MonadIO m => Lang -> Grammar -> String -> (Term -> InputT m b) -> InputT m (Maybe b) -parseThen l g s k = case runLangP l pTerm (BS.pack s) of - Left (Pn l c, err) -> do - outputStrLn $ err ++ " (" ++ show l ++ ":" ++ show c ++ ")" - return Nothing - Right t -> execCheck (renameSourceTerm g replModName t) $ \t -> k t - -data ResultState = ResultState - { srsResult :: Term - , srsChoices :: ChoiceMap - , srsOptInfo :: [OptionInfo] - , srsOpts :: ChoiceMap - } -data OptionState = OptionState - { osTerm :: Term - , osResults :: [ResultState] - , osSelected :: Maybe ResultState - } -newtype ReplState = ReplState - { rsOpts :: Maybe OptionState - } - -initState :: ReplState -initState = ReplState Nothing - -runRepl' :: ReplOpts -> Globals -> IO () -runRepl' opts@ReplOpts { lang, evalToFlat } gl@(Gl g _) = do - historyFile <- getAppUserDataDirectory "gfci_history" - runInputT (Settings noCompletion (Just historyFile) True) (repl initState) -- TODO tab completion - where - repl st = do - getInputLine "gfci> " >>= \case - Nothing -> repl st - Just (':' : l) -> let (cmd, arg) = break isSpace l in command st cmd (dropWhile isSpace arg) - Just code -> evalPrintLoop st code - - nlrepl st = outputStrLn "" >> repl st - - -- Show help text - command st "?" arg = do - outputStrLn ":? -- show help text." - outputStrLn ":t -- show the inferred type of ." - outputStrLn ":r -- show the results of the last eval." - outputStrLn ":s -- select the result at ." - outputStrLn ":c -- show the current selected result." - outputStrLn ":o -- set option to ." - outputStrLn ":q -- quit the REPL." - nlrepl st - - -- Show the inferred type of an expression - command st "t" arg = do - parseThen lang g arg $ \main -> - execCheck (inferLType gl main) $ \(t, ty) -> - let t' = case t of - Typed _ _ -> t - t -> Typed t ty - in outputStrLn $ render (ppTerm Unqualified 0 t') - nlrepl st - - -- Show the results of the last evaluated expression - command st "r" arg = do - case rsOpts st of - Nothing -> do - outputStrLn "No results to show!" - Just (OptionState t rs _) -> do - outputStrLn $ "> " ++ render (ppTerm Unqualified 0 t) - outputResults rs - nlrepl st - - -- Select a result to "focus" by its index - command st "s" arg = do - let e = do (OptionState t rs _) <- orLeft "No results to select!" $ rsOpts st - s <- orLeft "Could not parse result index!" $ readMaybe arg - (ResultState r cs ois os) <- orLeft "Result index out of bounds!" $ rs `maybeAt` (s - 1) - return (t, rs, r, cs, ois, os) - case e of - Left err -> do - outputStrLn err - nlrepl st - Right (t, rs, r, cs, ois, os) -> do - outputStrLn $ render (ppTerm Unqualified 0 r) - outputOptions ois os - nlrepl (st { rsOpts = Just (OptionState t rs (Just (ResultState r cs ois os))) }) - - -- Show the current selected result - command st "c" arg = do - let e = do (OptionState t _ sel) <- orLeft "No results to select!" $ rsOpts st - (ResultState r _ ois os) <- orLeft "No result selected!" sel - return (t, r, ois, os) - case e of - Left err -> outputStrLn err - Right (t, r, ois, os) -> do - outputStrLn $ "> " ++ render (ppTerm Unqualified 0 t) - outputStrLn $ render (ppTerm Unqualified 0 r) - outputOptions ois os - nlrepl st - - -- Set an option for the selected result - command st "o" arg = do - let e = do (OptionState t _ sel) <- orLeft "No results to select!" $ rsOpts st - (ResultState _ cs ois os) <- orLeft "No result selected!" sel - (c, i) <- case words arg of - [argc, argi] -> do - c <- orLeft "Could not parse option choice!" $ readMaybe argc - i <- orLeft "Could not parse option value!" $ readMaybe argi - return (c, i) - _ -> Left "Expected two arguments!" - when (i < 1) $ Left "Option value must be positive!" - oi <- orLeft "No such option!" $ find (\oi -> unchoice (optChoice oi) == c) ois - when (i > length (optChoices oi)) $ Left "Option value out of bounds!" - return (t, cs, ois, os, c, i) - case e of - Left err -> do - outputStrLn err - nlrepl st - Right (t, cs, ois, os, c, i) -> do - let os' = Map.insert (Choice c) (i - 1) os - nfs <- execCheck (doEval st t (Map.union os' cs)) pure - case nfs of - Nothing -> nlrepl st - Just [] -> do - outputStrLn "No results!" - nlrepl st - Just [(r, cs, ois')] -> do - outputStrLn $ render (ppTerm Unqualified 0 r) - let os'' = cleanOptions ois' os' - outputOptions ois' os'' - let rst = ResultState r (Map.difference cs os') ois' os'' - nlrepl (st { rsOpts = Just (OptionState t [rst] (Just rst)) }) - Just rs -> do - let rsts = rs <&> \(r, cs, ois') -> - ResultState r (Map.difference cs os') ois' (cleanOptions ois' os') - outputResults rsts - nlrepl (st { rsOpts = Just (OptionState t rsts Nothing) }) - - -- Quit the REPL - command _ "q" _ = outputStrLn "Bye!" - - command st cmd _ = do - outputStrLn $ "Unknown REPL command \"" ++ cmd ++ "\"! Use :? for help." - nlrepl st - - evalPrintLoop st code = do -- TODO bindings - c <- parseThen lang g code $ \main -> do - rsts <- execCheck (doEval st main Map.empty) $ \nfs -> do - if null nfs then do - outputStrLn "No results!" - return Nothing - else do - let rsts = nfs <&> \(r, cs, ois) -> ResultState r cs ois Map.empty - outputResults rsts - return $ Just rsts - return $ (main,) <$> join rsts - case join c of - Just (t, rs) -> nlrepl (ReplState (Just (OptionState t rs Nothing))) - Nothing -> nlrepl st - - doEval st t opts = inferLType gl t >>= \case - (t', _) -> runEvalMWithOpts gl opts (value2termM evalToFlat [] (eval gl [] unit t' [])) - - outputResults rs = - forM_ (zip [1..] rs) $ \(i, ResultState r _ opts _) -> - outputStrLn $ show i ++ (if null opts then ". " else "*. ") ++ render (ppTerm Unqualified 0 r) - - outputOptions ois os = - forM_ ois $ \(OptionInfo c n ls) -> do - outputStrLn "" - outputStrLn $ show (unchoice c) ++ ") " ++ render (ppValue Unqualified 0 n) - let sel = fromMaybe 0 (Map.lookup c os) + 1 - forM_ (zip [1..] ls) $ \(i, l) -> - outputStrLn $ (if i == sel then "->" else " ") ++ show i ++ ". " ++ render (ppValue Unqualified 0 l) - -runRepl :: ReplOpts -> IO () -runRepl opts@ReplOpts { noPrelude, inputFiles } = do - -- TODO accept an ngf grammar - let toLoad = if noPrelude then inputFiles else "prelude/Predef.gfo" : inputFiles - (g0, opens) <- case toLoad of - [] -> pure (mGrammar [], []) - _ -> do - (_, g0) <- batchCompile noOptions Nothing toLoad - pure (g0, OSimple . moduleNameS . justModuleName <$> toLoad) - let - modInfo = ModInfo - { mtype = MTResource - , mstatus = MSComplete - , mflags = noOptions - , mextend = [] - , mwith = Nothing - , mopens = opens - , mexdeps = [] - , msrc = replModNameStr - , mseqs = Nothing - , jments = Map.empty - } - g = Gl (prependModule g0 (replModName, modInfo)) (if noPrelude then Map.empty else stdPredef g) - runRepl' opts g diff --git a/src/compiler/gf-repl.hs b/src/compiler/gf-repl.hs deleted file mode 100644 index 5b890fa9e..000000000 --- a/src/compiler/gf-repl.hs +++ /dev/null @@ -1,12 +0,0 @@ -import GHC.IO.Encoding (setLocaleEncoding, utf8) - -import System.Environment (getArgs) -import GF.Compile.Repl (getReplOpts, runRepl) - -main :: IO () -main = do - setLocaleEncoding utf8 - args <- getArgs - case getReplOpts args of - Left errs -> mapM_ putStrLn errs - Right opts -> runRepl opts diff --git a/src/compiler/gf.cabal b/src/compiler/gf.cabal index 56875c9bb..a4f6bd7cf 100644 --- a/src/compiler/gf.cabal +++ b/src/compiler/gf.cabal @@ -121,7 +121,6 @@ library GF.Compile.GrammarToCanonical GF.Compile.ReadFiles GF.Compile.Rename - GF.Compile.Repl GF.Compile.SubExOpt GF.Compile.Tags GF.Compile.ToAPI @@ -239,12 +238,6 @@ executable gf build-depends: base >= 4.6 && <5, directory>=1.2, gf ghc-options: -threaded -executable gfci - main-is: gf-repl.hs - default-language: Haskell2010 - build-depends: base >= 4.6 && < 5, gf - ghc-options: -threaded - test-suite gf-tests type: exitcode-stdio-1.0 main-is: run.hs