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