From e6e18239a74a65f26f14fd27a411aed6b818b56c Mon Sep 17 00:00:00 2001 From: James Eversole Date: Fri, 7 Feb 2025 15:04:13 -0600 Subject: [PATCH] Smarter decoding of terms This update includes an update to `decodeResult` that makes string decoding far less aggressive. This also replaces the `!decode` REPL command with `!output` to allow users to switch output format on the fly. New tests are included for verifying decoding behavior; this group needs to be fleshed out further. --- src/REPL.hs | 69 ++++++++++++++++++++++++++++++------------------- src/Research.hs | 20 ++++++++++---- test/Spec.hs | 33 +++++++++++++++++++++++ tricu.cabal | 2 +- 4 files changed, 92 insertions(+), 32 deletions(-) diff --git a/src/REPL.hs b/src/REPL.hs index 9a83d9a..11e7f97 100644 --- a/src/REPL.hs +++ b/src/REPL.hs @@ -20,7 +20,7 @@ import System.Console.Haskeline import qualified Data.Map as Map repl :: Env -> IO () -repl env = runInputT settings (withInterrupt (loop env True)) +repl env = runInputT settings (withInterrupt (loop env Decode)) where settings :: Settings IO settings = Settings @@ -33,19 +33,17 @@ repl env = runInputT settings (withInterrupt (loop env True)) completeCommands str = return $ map simpleCompletion $ filter (str `isPrefixOf`) commands where - commands = ["!exit", "!decode", "!definitions", "!import"] + commands = ["!exit", "!output", "!definitions", "!import"] - loop :: Env -> Bool -> InputT IO () - loop env decode = handle (interruptHandler env decode) $ do + loop :: Env -> EvaluatedForm -> InputT IO () + loop env form = handle (interruptHandler env form) $ do minput <- getInputLine "tricu < " case minput of Nothing -> outputStrLn "Exiting tricu" Just s - | strip s == "" -> loop env decode + | strip s == "" -> loop env form | strip s == "!exit" -> outputStrLn "Exiting tricu" - | strip s == "!decode" -> do - outputStrLn $ "Decoding " ++ (if decode then "disabled" else "enabled") - loop env (not decode) + | strip s == "!output" -> handleOutput env form | strip s == "!definitions" -> do let defs = Map.keys $ Map.delete "!result" env if null defs @@ -53,15 +51,37 @@ repl env = runInputT settings (withInterrupt (loop env True)) else do outputStrLn "Available definitions:" mapM_ outputStrLn defs - loop env decode - | "!import" `isPrefixOf` strip s -> handleImport env decode - | take 2 s == "--" -> loop env decode + loop env form + | "!import" `isPrefixOf` strip s -> handleImport env form + | take 2 s == "--" -> loop env form | otherwise -> do - newEnv <- liftIO $ processInput env s decode `catch` errorHandler env - loop newEnv decode + newEnv <- liftIO $ processInput env s form `catch` errorHandler env + loop newEnv form - handleImport :: Env -> Bool -> InputT IO () - handleImport env decode = do + handleOutput :: Env -> EvaluatedForm -> InputT IO () + handleOutput env currentForm = do + let formats = [Decode, TreeCalculus, FSL, AST, Ternary, Ascii] + outputStrLn "Available output formats:" + mapM_ (\(i, f) -> outputStrLn $ show i ++ ". " ++ show f) + (zip [1..] formats) + + result <- runMaybeT $ do + input <- MaybeT $ getInputLine "Select output format (1-6) < " + case reads input of + [(n, "")] | n >= 1 && n <= 6 -> + return $ formats !! (n-1) + _ -> MaybeT $ return Nothing + + case result of + Nothing -> do + outputStrLn "Invalid selection. Keeping current output format." + loop env currentForm + Just newForm -> do + outputStrLn $ "Output format changed to: " ++ show newForm + loop env newForm + + handleImport :: Env -> EvaluatedForm -> InputT IO () + handleImport env form = do result <- runMaybeT $ do let fileSettings = setComplete completeFilename defaultSettings path <- MaybeT $ runInputT fileSettings $ @@ -84,26 +104,23 @@ repl env = runInputT settings (withInterrupt (loop env True)) if | Nothing <- result -> do outputStrLn "Import cancelled." - loop env decode + loop env form | Just loadedEnv <- result -> - loop (Map.delete "!result" loadedEnv) decode + loop (Map.delete "!result" loadedEnv) form - interruptHandler :: Env -> Bool -> Interrupt -> InputT IO () - interruptHandler env decode _ = do + interruptHandler :: Env -> EvaluatedForm -> Interrupt -> InputT IO () + interruptHandler env form _ = do outputStrLn "Interrupted with CTRL+C\n\ \You can use the !exit command or CTRL+D to exit" - loop env decode + loop env form - processInput :: Env -> String -> Bool -> IO Env - processInput env input decode = do + processInput :: Env -> String -> EvaluatedForm -> IO Env + processInput env input form = do let asts = parseTricu input newEnv = evalTricu env asts case Map.lookup "!result" newEnv of Just r -> do - putStrLn $ "tricu > " ++ - if decode - then decodeResult r - else show r + putStrLn $ "tricu > " ++ formatResult form r Nothing -> pure () return newEnv diff --git a/src/Research.hs b/src/Research.hs index 23371ce..0e79eb8 100644 --- a/src/Research.hs +++ b/src/Research.hs @@ -160,8 +160,18 @@ toAscii tree = go tree "" True ++ go right (prefix ++ (if isLast then " " else "| ")) True decodeResult :: T -> String -decodeResult tc - | Right num <- toNumber tc = show num - | Right str <- toString tc = "\"" ++ str ++ "\"" - | Right list <- toList tc = "[" ++ intercalate ", " (map decodeResult list) ++ "]" - | otherwise = formatResult TreeCalculus tc +decodeResult Leaf = "t" +decodeResult tc = + case (toString tc, toList tc, toNumber tc) of + (Right s, _, _) | all isCommonChar s -> "\"" ++ s ++ "\"" + (_, _, Right n) -> show n + (_, Right xs@(_:_), _) -> "[" ++ intercalate ", " (map decodeResult xs) ++ "]" + (_, Right [], _) -> "[]" + _ -> formatResult TreeCalculus tc + where + isCommonChar c = + let n = fromEnum c + in (n >= 32 && n <= 126) + || n == 9 + || n == 10 + || n == 13 diff --git a/test/Spec.hs b/test/Spec.hs index 5a468b4..86b97d7 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -34,6 +34,7 @@ tests = testGroup "Tricu Tests" , fileEval , modules , demos + , decoding ] lexer :: TestTree @@ -522,3 +523,35 @@ demos = testGroup "Test provided demo functionality" res <- liftIO $ evaluateFileResult "./demos/levelOrderTraversal.tri" decodeResult res @?= "\"\n1 \n2 3 \n4 5 6 7 \n8 11 10 9 12 \"" ] + +decoding :: TestTree +decoding = testGroup "Decoding Tests" + [ testCase "Decode Leaf" $ do + decodeResult Leaf @?= "t" + + , testCase "Decode list of non-ASCII numbers" $ do + let input = ofList [ofNumber 1, ofNumber 14, ofNumber 6] + decodeResult input @?= "[1, 14, 6]" + + , testCase "Decode list of ASCII numbers as a string" $ do + let input = ofList [ofNumber 97, ofNumber 98, ofNumber 99] + decodeResult input @?= "\"abc\"" + + , testCase "Decode small number" $ do + decodeResult (ofNumber 42) @?= "42" + + , testCase "Decode large number" $ do + decodeResult (ofNumber 9999) @?= "9999" + + , testCase "Decode string in list" $ do + let input = ofList [ofString "hello", ofString "world"] + decodeResult input @?= "[\"hello\", \"world\"]" + + , testCase "Decode mixed list with strings" $ do + let input = ofList [ofString "hello", ofNumber 42, ofString "world"] + decodeResult input @?= "[\"hello\", 42, \"world\"]" + + , testCase "Decode nested lists with strings" $ do + let input = ofList [ofList [ofString "nested"], ofString "string"] + decodeResult input @?= "[[\"nested\"], \"string\"]" + ] \ No newline at end of file diff --git a/tricu.cabal b/tricu.cabal index 9a0ba0f..bd01006 100644 --- a/tricu.cabal +++ b/tricu.cabal @@ -1,7 +1,7 @@ cabal-version: 1.12 name: tricu -version: 0.16.0 +version: 0.17.0 description: A micro-language for exploring Tree Calculus author: James Eversole maintainer: james@eversole.co