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

@@ -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
 

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

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\"]"
+  ]

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