commit b1e03b32cbbe64adcf8c76af88ae49c1a26fb963
parent 4a625503e4ea2c6cff8fe19161cf3e865642b37e
Author: James Eversole <james@eversole.co>
Date: Fri, 7 Feb 2025 15:04:13 -0600
Smarter decoding of terms
Diffstat:
4 files changed, 93 insertions(+), 32 deletions(-)
diff --git 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
@@ -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
@@ -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
@@ -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
