Humanification of lists

2 files changed, 27 insertions, 22 deletions

diff --git a/src/Eval.hs b/src/Eval.hs
index 6f8a0a5..d248b98 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -281,17 +281,15 @@ evalCommand inp s@(EnvState env@(Environment envDefs) conf cache) = \case
     pure s
 
 -- TODO: Reduce redundancy
-showResult :: Expression -> Expression -> Environment -> IO ()
-showResult orig reduced env =
-  putStrLn
-    $  "<> "
-    <> (show orig)
-    <> "\n*> "
-    <> (show reduced)
-    <> "\n?> "
-    <> (humanifyExpression reduced)
-    <> "\n#> "
-    <> (matchingFunctions reduced env)
+showResult :: Expression -> Environment -> IO ()
+showResult reduced env =
+  let matching   = matchingFunctions reduced env
+      humanified = humanifyExpression reduced
+  in  putStrLn
+        $  "*> "
+        <> (show reduced)
+        <> (if null humanified then "" else "\n?> " <> humanified)
+        <> (if null matching then "" else "\n#> " <> matching)
 
 evalInstruction
   :: Instruction -> EnvState -> (EnvState -> IO EnvState) -> IO EnvState
@@ -313,7 +311,7 @@ evalInstruction (ContextualInstruction instr inp) s@(EnvState env conf _) rec =
             Left  err -> print err >> rec s
             Right e'  -> do
               red <- reduce e'
-              showResult e' red env
+              showResult red env
               rec s
           )
     Commands cs -> yeet (pure s) cs >>= rec
@@ -362,7 +360,7 @@ evalFileConf path conf = do
       $ ContextualError (UndefinedIdentifier entryFunction) (Context "" path)
     Just EnvDef { _exp = e } -> do
       red <- reduce $ Application e arg
-      showResult e red (Environment env)
+      showResult red (Environment env)
 
 evalFile :: String -> IO ()
 evalFile path = evalFileConf path (defaultConf path)
@@ -379,7 +377,7 @@ exec path rd conv = do
     Left  exception -> print (exception :: IOError)
     Right f'        -> do
       red <- reduce $ Application e arg
-      showResult e red (Environment M.empty)
+      showResult red (Environment M.empty)
       where e = fromBinary $ conv f'
 
 repl :: EnvState -> InputT M ()
diff --git a/src/Helper.hs b/src/Helper.hs
index 7c49815..9bc2fb0 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -260,19 +260,26 @@ matchingFunctions e (Environment env) =
     (\EnvDef { _exp = e' } -> e == e')
     env
 
--- TODO: Expression -> Maybe Char is missing
+-- TODO: Show binary as char if in ascii range (=> + humanify strings)
 maybeHumanifyExpression :: Expression -> Maybe String
 maybeHumanifyExpression e =
-  binaryToDecimal e
+  unaryToDecimal e
+    <|> binaryToDecimal e
     <|> ternaryToDecimal e
-    <|> unaryToDecimal e
-    <|> decodeStdout e
+    <|> humanifyList e
 
 humanifyExpression :: Expression -> String
 humanifyExpression e = case maybeHumanifyExpression e of
-  Nothing -> show e
+  Nothing -> ""
   Just h  -> h
 
+humanifyList :: Expression -> Maybe String
+humanifyList e = do
+  es <- unlistify e
+  let conv x = maybe (show x) id (maybeHumanifyExpression x)
+      m = map conv es
+  pure $ "{" <> intercalate ", " m <> "}"
+
 ---
 
 -- Dec to Bal3 in Bruijn encoding: reversed application with 0=>0; 1=>1; T=>2; end=>3
@@ -304,7 +311,7 @@ decimalToUnary n | otherwise = Abstraction $ Abstraction $ gen n
 unaryToDecimal :: Expression -> Maybe String
 unaryToDecimal e = do
   res <- resolve e
-  return $ show $ (sum res :: Integer)
+  return $ show (sum res :: Integer) <> "u"
  where
   multiplier (Bruijn 1) = Just 1
   multiplier _          = Nothing
@@ -320,7 +327,7 @@ unaryToDecimal e = do
 binaryToDecimal :: Expression -> Maybe String
 binaryToDecimal e = do
   res <- resolve e
-  return $ show $ (sum $ zipWith (*) res (iterate (* 2) 1) :: Integer)
+  return $ show (sum $ zipWith (*) res (iterate (* 2) 1) :: Integer) <> "b"
  where
   multiplier (Bruijn 0) = Just 0
   multiplier (Bruijn 1) = Just 1
@@ -337,7 +344,7 @@ binaryToDecimal e = do
 ternaryToDecimal :: Expression -> Maybe String
 ternaryToDecimal e = do
   res <- resolve e
-  return $ show $ (sum $ zipWith (*) res (iterate (* 3) 1) :: Integer)
+  return $ show (sum $ zipWith (*) res (iterate (* 3) 1) :: Integer) <> "t"
  where
   multiplier (Bruijn 0) = Just 0
   multiplier (Bruijn 1) = Just 1